aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Internal/Keys.hs55
-rw-r--r--src/Internal/Lib.hs67
-rw-r--r--src/Internal/Marking.hs80
-rw-r--r--src/Internal/XPlus.hs53
4 files changed, 75 insertions, 180 deletions
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 64a7506..591861f 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -7,7 +7,6 @@ import Graphics.X11.ExtraTypes.XorgDefault
import System.Process
import XMonad.Util.Ungrab
import XMonad.Layout.Spacing
-import Internal.XPlus
import Data.Maybe (isJust)
import Debug.Trace
import Control.Applicative
@@ -40,14 +39,13 @@ import Internal.PassMenu
type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
applyKeys :: XConfig l -> IO (XConfig l)
-applyKeys config@(XConfig {modMask = modm}) =
- withNewMarkContext $ \markContext -> do
- ks <- newKeys markContext
- ms <- newMouse markContext
+applyKeys config@(XConfig {modMask = modm}) = do
+ ks <- newKeys
+ ms <- newMouse
return $ config { keys = ks, mouseBindings = ms }
-newMouse :: MarkContext -> IO (XConfig l -> Map (KeyMask, Button) (Window -> X ()))
-newMouse markContext =
+newMouse :: IO (XConfig l -> Map (KeyMask, Button) (Window -> X ()))
+newMouse =
return $ \config@(XConfig {modMask = modm}) ->
Map.fromList [
((modm, button1), \w -> focus w >> mouseMoveWindow w >> windows W.shiftMaster)
@@ -71,8 +69,8 @@ modifyWindowBorder :: Integer -> SpacingModifier
modifyWindowBorder i = ModifyWindowBorder $ \(Border a b c d) ->
(Border (a + i) (b + i) (c + i) (d + i))
-newKeys :: MarkContext -> IO (KeyMap l)
-newKeys markContext =
+newKeys :: IO (KeyMap l)
+newKeys =
return $ \config@(XConfig {modMask = modm}) ->
Map.fromList
[ ((modm, xK_F12), (void $ spawn "spotify-control next"))
@@ -100,33 +98,30 @@ newKeys markContext =
, ((mod4Mask, xK_BackSpace), (void $ spawn "xterm"))
, ((modm, xK_BackSpace), (void $ spawn "pkill -SIGUSR1 xmobar"))
, ((modm, xK_t), (void $ spawn (terminal config)))
- , ((modm, xK_m), (submap $ mapAlpha modm (markCurrentWindow markContext)))
- , ((modm, xK_w), runXPlus markContext config windowJump)
+ , ((modm, xK_m), (submap $ mapAlpha modm markCurrentWindow))
+ , ((modm, xK_w), windowJump)
, ((modm, xK_space), sendMessage NextLayout)
, ((modm .|. shiftMask, xK_space), sendMessage FirstLayout)
, ((modm, xK_apostrophe), (submap $
Map.insert
(modm, xK_apostrophe)
- (jumpToLast markContext)
- (mapAlpha modm (jumpToMark markContext))))
+ jumpToLast
+ (mapAlpha modm jumpToMark)))
, ((modm .|. shiftMask, xK_apostrophe), (submap $
Map.insert
(modm .|. shiftMask, xK_apostrophe)
- (swapWithLastMark markContext)
- (mapAlpha (modm .|. shiftMask) (swapWithMark markContext))))
+ swapWithLastMark
+ (mapAlpha (modm .|. shiftMask) swapWithMark)))
, ((modm, xK_g), (submap $
- mapNumbersAndAlpha 0 (
- runXPlus markContext config . gotoWorkspace)))
+ mapNumbersAndAlpha 0 gotoWorkspace))
, ((modm .|. shiftMask, xK_g), (submap $
- mapNumbersAndAlpha 0 (
- runXPlus markContext config . shiftToWorkspace)))
+ mapNumbersAndAlpha 0 shiftToWorkspace))
, ((modm .|. shiftMask .|. mod1Mask, xK_g), (submap $
- mapNumbersAndAlpha 0 (
- runXPlus markContext config . swapWorkspace)))
+ mapNumbersAndAlpha 0 swapWorkspace))
, ((modm, xK_minus), sendMessage (IncMasterN (-1)))
, ((modm, xK_plus), sendMessage (IncMasterN 1))
@@ -149,17 +144,17 @@ newKeys markContext =
, ((modm, xK_Tab), windows W.focusDown)
, ((modm .|. shiftMask, xK_Tab), windows W.focusUp)
- , ((modm, xK_a), runXPlus markContext config (withScreen W.view 0))
- , ((modm, xK_o), runXPlus markContext config (withScreen W.view 1))
- , ((modm, xK_e), runXPlus markContext config (withScreen W.view 2))
+ , ((modm, xK_a), withScreen W.view 0)
+ , ((modm, xK_o), withScreen W.view 1)
+ , ((modm, xK_e), withScreen W.view 2)
- , ((modm .|. shiftMask, xK_a), runXPlus markContext config (withScreen W.shift 0))
- , ((modm .|. shiftMask, xK_o), runXPlus markContext config (withScreen W.shift 1))
- , ((modm .|. shiftMask, xK_e), runXPlus markContext config (withScreen W.shift 2))
+ , ((modm .|. shiftMask, xK_a), withScreen W.shift 0)
+ , ((modm .|. shiftMask, xK_o), withScreen W.shift 1)
+ , ((modm .|. shiftMask, xK_e), withScreen W.shift 2)
- , ((modm .|. mod1Mask, xK_a), runXPlus markContext config (withScreen W.greedyView 0))
- , ((modm .|. mod1Mask, xK_o), runXPlus markContext config (withScreen W.greedyView 1))
- , ((modm .|. mod1Mask, xK_e), runXPlus markContext config (withScreen W.greedyView 2))
+ , ((modm .|. mod1Mask, xK_a), withScreen W.greedyView 0)
+ , ((modm .|. mod1Mask, xK_o), withScreen W.greedyView 1)
+ , ((modm .|. mod1Mask, xK_e), withScreen W.greedyView 2)
, ((modm, xK_b), sendMessage ToggleStruts)
-- Buttons programmed on my mouse.
diff --git a/src/Internal/Lib.hs b/src/Internal/Lib.hs
index 08ba2b7..1a1d602 100644
--- a/src/Internal/Lib.hs
+++ b/src/Internal/Lib.hs
@@ -15,7 +15,6 @@ import Data.List hiding ((!!))
import Data.List.Safe ((!!))
import Data.Maybe
import Internal.Marking
-import Internal.XPlus
import Text.Printf
import XMonad hiding (workspaces, Screen)
import XMonad.StackSet hiding (filter, focus)
@@ -65,18 +64,16 @@ getHorizontallyOrderedScreens windowSet =
screens = current windowSet : visible windowSet
-gotoWorkspace :: WorkspaceName -> XPlus l ()
+gotoWorkspace :: WorkspaceName -> X ()
gotoWorkspace ch = do
- mc <- getMarkContext
- liftXPlus $ do
- saveLastMark mc
- windows $ greedyView $ return ch
+ saveLastMark
+ windows $ greedyView $ return ch
-shiftToWorkspace :: WorkspaceName -> XPlus l ()
-shiftToWorkspace = liftXPlus . windows . shift . return
+shiftToWorkspace :: WorkspaceName -> X ()
+shiftToWorkspace = windows . shift . return
-swapWorkspace :: WorkspaceName -> XPlus l ()
-swapWorkspace toWorkspaceName = liftXPlus $ do
+swapWorkspace :: WorkspaceName -> X ()
+swapWorkspace toWorkspaceName = do
windows $ \ss -> do
let fromWorkspace = tag $ workspace $ current ss
toWorkspace = [toWorkspaceName] in
@@ -128,40 +125,22 @@ prev :: Selector
prev = Selector $ \a l ->
let (Selector fn) = next in fn a (reverse l)
-withScreen :: (WorkspaceId -> WindowSet -> WindowSet) -> Int -> XPlus l ()
+withScreen :: (WorkspaceId -> WindowSet -> WindowSet) -> Int -> X ()
withScreen fn n = do
- markContext <- getMarkContext
+ windows $ \windowSet ->
+ case (getHorizontallyOrderedScreens windowSet !! n) of
+ Nothing -> windowSet
+ Just screen -> fn (tag $ workspace screen) windowSet
- liftXPlus $
- windows $ \windowSet ->
- case (getHorizontallyOrderedScreens windowSet !! n) of
- Nothing -> windowSet
- Just screen -> fn (tag $ workspace screen) windowSet
-
-windowJump :: XPlus l ()
+windowJump :: X ()
windowJump = do
- markContext <- getMarkContext
-
- liftXPlus $ do
- windowTitlesToWinId <- withWindowSet $ \ss ->
- Map.fromList <$> mapM (\wid -> (,) <$> getString wid <*> return wid) (allWindows ss)
-
- windowId <- runDMenuPromptWithMap "Window" (Just "#f542f5") windowTitlesToWinId
-
- case windowId of
- Nothing -> return ()
- Just wid -> do
- saveLastMark markContext
- focus wid
- -- mkXPrompt
- -- WinPrompt
- -- xpConfig
- -- (\input -> return $ filter (fuzzyCompletion input) (Map.keys windowTitlesToWinId)) $
- -- \str -> do
- -- saveLastMark markContext
- -- case Map.lookup str windowTitlesToWinId of
- -- Just w -> focus w
- -- Nothing ->
- -- case filter (fuzzyCompletion str) (Map.keys windowTitlesToWinId) of
- -- [s] -> mapM_ focus (Map.lookup s windowTitlesToWinId)
- -- _ -> return ()
+ windowTitlesToWinId <- withWindowSet $ \ss ->
+ Map.fromList <$> mapM (\wid -> (,) <$> getString wid <*> return wid) (allWindows ss)
+
+ windowId <- runDMenuPromptWithMap "Window" (Just "#f542f5") windowTitlesToWinId
+
+ case windowId of
+ Nothing -> return ()
+ Just wid -> do
+ saveLastMark
+ focus wid
diff --git a/src/Internal/Marking.hs b/src/Internal/Marking.hs
index f9083d2..229ea02 100644
--- a/src/Internal/Marking.hs
+++ b/src/Internal/Marking.hs
@@ -11,6 +11,8 @@ import System.IO
import Control.Exception
import System.Environment
+import qualified XMonad.Util.ExtensibleState as XS
+
import qualified Data.Map as Map
{- Submodule that handles marking windows so they can be jumped back to. -}
@@ -23,65 +25,38 @@ data MarkState =
, markLast :: Maybe Window
} deriving (Read, Show)
-data MarkContext = MarkContext (IORef MarkState)
-
-readMarkState :: IO MarkState
-readMarkState = do
- -- TODO(rahm) The mark state should use the extensible state constructs in the
- -- XState rather than relying on IO.
- dir <- getEnv "HOME"
- let markstate = dir </> ".xmonad" </> "markstate"
- catch
- (read <$> (hGetContents =<< openFile markstate ReadMode))
- (\(e :: IOError) -> return (MarkState mempty Nothing))
-
-saveMarkState :: MarkState -> X ()
-saveMarkState ms = do
- dir <- io $ getEnv "HOME"
- let markstate = dir </> ".xmonad" </> "markstate"
- liftIO $ writeFile markstate (show ms)
-
-withNewMarkContext :: (MarkContext -> IO a) -> IO a
-withNewMarkContext fn = do
- ioref <- newIORef =<< readMarkState
- fn (MarkContext ioref)
+instance ExtensionClass MarkState where
+ initialValue = MarkState Map.empty Nothing
-markCurrentWindow :: MarkContext -> Mark -> X ()
-markCurrentWindow (MarkContext ioref) mark = do
+markCurrentWindow :: Mark -> X ()
+markCurrentWindow mark = do
withFocused $ \win ->
- liftIO $
- modifyIORef ioref $ \state@(MarkState {markStateMap = ms}) ->
+ XS.modify $ \state@(MarkState {markStateMap = ms}) ->
state {
markStateMap = Map.insert mark win ms
}
- saveMarkState =<< liftIO (readIORef ioref)
-
-saveLastMark :: MarkContext -> X ()
-saveLastMark (MarkContext ioref) =
- withFocused $ \win -> do
- liftIO $ modifyIORef ioref (\state -> state { markLast = Just win })
+saveLastMark :: X ()
+saveLastMark =
+ withFocused $ \win ->
+ XS.modify $ \state -> state { markLast = Just win }
-jumpToLast :: MarkContext -> X ()
-jumpToLast ctx@(MarkContext ioref) = do
- m <- markLast <$> (liftIO $ readIORef ioref)
- saveLastMark ctx
+jumpToLast :: X ()
+jumpToLast = do
+ m <- markLast <$> XS.get
+ saveLastMark
mapM_ focus m
- saveMarkState =<< liftIO (readIORef ioref)
-
-jumpToMark :: MarkContext -> Mark -> X ()
-jumpToMark ctx@(MarkContext ioref) mark = do
- MarkState {markStateMap = m} <- liftIO $ readIORef ioref
+jumpToMark :: Mark -> X ()
+jumpToMark mark = do
+ MarkState {markStateMap = m} <- XS.get
case Map.lookup mark m of
Nothing -> return ()
Just w -> do
- saveLastMark ctx
+ saveLastMark
focus w
- saveMarkState =<< liftIO (readIORef ioref)
-
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
@@ -117,20 +92,19 @@ swapWithFocused winToSwap stackSet =
mapWindows (
\w -> if w == winToSwap then focused else w) stackSet
-swapWithLastMark :: MarkContext -> X ()
-swapWithLastMark ctx@(MarkContext ioref) = do
- MarkState {markStateMap = m} <- liftIO $ readIORef ioref
- m <- markLast <$> (liftIO $ readIORef ioref)
- saveLastMark ctx
+swapWithLastMark :: X ()
+swapWithLastMark = do
+ m <- markLast <$> XS.get
+ saveLastMark
case m of
Nothing -> return ()
Just win -> windows $ swapWithFocused win
-swapWithMark :: MarkContext -> Mark -> X ()
-swapWithMark ctx@(MarkContext ioref) mark = do
- MarkState {markStateMap = m} <- liftIO $ readIORef ioref
- saveLastMark ctx
+swapWithMark :: Mark -> X ()
+swapWithMark mark = do
+ MarkState {markStateMap = m} <- XS.get
+ saveLastMark
case Map.lookup mark m of
Nothing -> return ()
diff --git a/src/Internal/XPlus.hs b/src/Internal/XPlus.hs
deleted file mode 100644
index c546665..0000000
--- a/src/Internal/XPlus.hs
+++ /dev/null
@@ -1,53 +0,0 @@
-module Internal.XPlus where
-
-import Internal.Marking
-import XMonad
-
--- The X Monad with additional information. Used for configuring the system.
-
-data XPlusState l =
- XPlusState {
- markContext :: MarkContext
- , xConfig :: XConfig l
- }
-
-data XPlus l a = XPlus (XPlusState l -> X (a, XPlusState l))
-
-instance Functor (XPlus l) where
- fmap fn (XPlus xfn) =
- XPlus $ \st -> do
- (a, b) <- xfn st
- return (fn a, b)
-
-instance Applicative (XPlus l) where
- pure = return
- (<*>) afn aarg = do
- fn <- afn
- arg <- aarg
- return (fn arg)
-
-instance Monad (XPlus l) where
- -- (>>=) :: XPlus l a -> (a -> XPlus l b) -> XPlus l b
- (>>=) (XPlus afn) bfn = do
- XPlus $ \s0 -> do
- (a, s1) <- afn s0
- let (XPlus xBFn) = bfn a
- xBFn s1
-
- return x = XPlus $ \s -> return (x, s)
-
-getXPlusState :: XPlus l (XPlusState l)
-getXPlusState = XPlus $ \s -> return (s, s)
-
-getXConfig :: XPlus l (XConfig l)
-getXConfig = xConfig <$> getXPlusState
-
-getMarkContext :: XPlus l MarkContext
-getMarkContext = markContext <$> getXPlusState
-
-runXPlus :: MarkContext -> XConfig l -> XPlus l a -> X a
-runXPlus markCtx cfg (XPlus fn) = do
- fst <$> fn (XPlusState markCtx cfg)
-
-liftXPlus :: X a -> XPlus l a
-liftXPlus xa = XPlus $ \s -> (\a -> (a, s)) <$> xa
generated by cgit (git 2.34.1) at 2026-02-22 17:56:30 +0000