aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Rahm/Desktop/Keys.hs379
-rw-r--r--src/Rahm/Desktop/Keys/Wml.hs233
2 files changed, 336 insertions, 276 deletions
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 9b72494..fb62bee 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -75,6 +75,7 @@ import Rahm.Desktop.Keys.Wml
readWorkspaceMacro,
removeWindowFromSelection,
toggleWindowInSelection,
+ withNextWorkspaceOrKey,
workspaceForString,
workspaceForStringT,
workspaceName,
@@ -245,13 +246,13 @@ bindings = do
ifM
D.isDragging
(D.finishDrag >> withFocused D.sinkByWindowUnderCursor)
- $ pushPendingBuffer "' "
- $ do
- runMaybeT_ $ do
- l <- readNextLocationSet'
- case l of
- (h : _) -> lift (focusLocation h)
- _ -> return ()
+ $ pushPendingBuffer "' " $
+ do
+ runMaybeT_ $ do
+ l <- readNextLocationSet'
+ case l of
+ (h : _) -> lift (focusLocation h)
+ _ -> return ()
shiftMod $
doc "Drag workspace to another." D.dragWindow
@@ -278,20 +279,20 @@ bindings = do
lift $ do
setAlternateWindows (l1'' ++ l2')
windows $ W.swapWindows $ zip l1'' l2' ++ zip l2' l1''
- shiftMod
- $ doc
+ shiftMod $
+ doc
"Swap two workspaces (or rename the current one). \
\(only works on normal workspaces)."
- $ pushPendingBuffer "W "
- $ do
- logs Debug "%s" . W.dbgStackSet =<< gets windowset
- runMaybeT_ $ do
- w1 <- readNextWorkspaceName
- wins <- lift $ W.windowsOnWorkspace w1 <$> gets windowset
- withBorderColorM selectedWindowsColor wins $ do
- lift $ addStringToPendingBuffer " "
- w2 <- readNextWorkspaceName
- lift $ windows $ W.swapWorkspaces w1 w2
+ $ pushPendingBuffer "W " $
+ do
+ logs Debug "%s" . W.dbgStackSet =<< gets windowset
+ runMaybeT_ $ do
+ w1 <- readNextWorkspaceName
+ wins <- lift $ W.windowsOnWorkspace w1 <$> gets windowset
+ withBorderColorM selectedWindowsColor wins $ do
+ lift $ addStringToPendingBuffer " "
+ w2 <- readNextWorkspaceName
+ lift $ windows $ W.swapWorkspaces w1 w2
bind xK_BackSpace $ do
-- The only raw keybinding. Meant to get a terminal to unbrick XMonad if
@@ -314,12 +315,12 @@ bindings = do
++ documentation config bindings
bind xK_F1 $ do
- justMod
- $ doc
+ justMod $
+ doc
"Print this documentation"
- $ do
- doc <- getDoc
- safeSpawn "gxmessage" ["-fn", "Source Code Pro", doc]
+ $ do
+ doc <- getDoc
+ safeSpawn "gxmessage" ["-fn", "Source Code Pro", doc]
bind xK_F7 $ do
justMod $
@@ -389,8 +390,8 @@ bindings = do
sendMessage flipHorizontally
bind xK_g $ do
- justMod
- $ doc
+ justMod $
+ doc
"Goto To a workspace\n\n\t\
\Workspacs are alphanumeric characters. So if the next key typed is an\n\t\
\alphanumeric character, that's the workspace to operate on\n\n\
@@ -409,58 +410,66 @@ bindings = do
\_: Black hole. Sending a window here closes it.\n\n\t\
\Other keybindings starting with H-g\n\t\t\
\F1: display this help.\n\n\t"
- $ pushPendingBuffer "g "
- $ runMaybeT_
- $ (lift . gotoWorkspaceFn) =<< readNextWorkspace
-
- shiftMod
- $ doc
+ $ pushPendingBuffer "g " $
+ runMaybeT_ $
+ withNextWorkspaceOrKey
+ gotoWorkspaceFn
+ ( \case
+ (_, s, _) | s == xK_F1 -> do
+ doc <- getDoc
+ safeSpawn "gxmessage" ["-fn", "Source Code Pro", doc]
+ (_, s, _) | s == xK_F5 -> do
+ spawnX "xmonad --recompile && xmonad --restart"
+ _ -> return ()
+ )
+ shiftMod $
+ doc
"Switch a workspace with another workspace. \
\This is a more powerful version of the 'g' command, which does not\
\assume the current workspace.\
\which takes two workspaces as arguments and switches them whereas\
\the 'g' command operates only on the current workspace (.).\
\thereby G.<ws> is the same as g<ws>"
- $ do
- pushPendingBuffer "G " $ do
- runMaybeT_ $ do
- w1 <- readNextWorkspaceName
- lift $ addStringToPendingBuffer " "
- w2 <- readNextWorkspaceName
- lift $ windows $ W.switchWorkspaces w1 w2
+ $ do
+ pushPendingBuffer "G " $ do
+ runMaybeT_ $ do
+ w1 <- readNextWorkspaceName
+ lift $ addStringToPendingBuffer " "
+ w2 <- readNextWorkspaceName
+ lift $ windows $ W.switchWorkspaces w1 w2
bind xK_d $
justMod $
doc "Record (define) macros." $
subbind $ do
- bind xK_w
- $ noMod
- $ doc
- "Record a windowset macro.\n\n\t\
- \To record a 'windowset' macro, type <M-d>w<key> and then\n\t\
- \type a character sequence followed by Enter. Now <key> can\n\t\
- \be used anywhere a 'windowset' is required and that macro\n\t\
- \will be used.\n\n\t\
- \For example, if one wants to define '+' as 'all windows \n\t\
- \not on the current workspace, one can type:\n\n\t\
- \<M-d>w+\\%@.<Enter>\n"
- $ pushPendingBuffer "Win Macro "
- $ runMaybeT_ readWindowsetMacro
-
- bind xK_t
- $ noMod
- $ doc
- "Record a workspace macro\n\n\t\
- \To record a 'workspace' macro, type <M-d>t<key> and then\n\t\
- \type a character sequence followed by Enter. Now <key> can\n\t\
- \be used anywhere a 'workspace' is required and that macro\n\t\
- \will be used.\n\n\t\
- \For example, if one wants to define '<c-s>' as 'the workspace with\n\t\
- \the window 's' on it or the last workspace if already on that \n\t\
- \workspace (more useful that one would think):\n\n\t\
- \<M-d>t<c-s>?&s@.'s<Enter>\n"
- $ pushPendingBuffer "Wksp Macro "
- $ runMaybeT_ readWorkspaceMacro
+ bind xK_w $
+ noMod $
+ doc
+ "Record a windowset macro.\n\n\t\
+ \To record a 'windowset' macro, type <M-d>w<key> and then\n\t\
+ \type a character sequence followed by Enter. Now <key> can\n\t\
+ \be used anywhere a 'windowset' is required and that macro\n\t\
+ \will be used.\n\n\t\
+ \For example, if one wants to define '+' as 'all windows \n\t\
+ \not on the current workspace, one can type:\n\n\t\
+ \<M-d>w+\\%@.<Enter>\n"
+ $ pushPendingBuffer "Win Macro " $
+ runMaybeT_ readWindowsetMacro
+
+ bind xK_t $
+ noMod $
+ doc
+ "Record a workspace macro\n\n\t\
+ \To record a 'workspace' macro, type <M-d>t<key> and then\n\t\
+ \type a character sequence followed by Enter. Now <key> can\n\t\
+ \be used anywhere a 'workspace' is required and that macro\n\t\
+ \will be used.\n\n\t\
+ \For example, if one wants to define '<c-s>' as 'the workspace with\n\t\
+ \the window 's' on it or the last workspace if already on that \n\t\
+ \workspace (more useful that one would think):\n\n\t\
+ \<M-d>t<c-s>?&s@.'s<Enter>\n"
+ $ pushPendingBuffer "Wksp Macro " $
+ runMaybeT_ readWorkspaceMacro
bind xK_h $ do
justMod $
@@ -527,13 +536,13 @@ bindings = do
lift $ mapM_ unpinWindow windows
bind xK_minus $ do
- justMod
- $ doc
+ justMod $
+ doc
"Decrease the number of windows in the master region, or decrease\n\t\
\the size of the master region if the current layout cannot have more\n\t\
\than one window in the master region."
- $ sendMessage
- $ IncMasterN (-1)
+ $ sendMessage $
+ IncMasterN (-1)
shiftMod $
doc "For mosaic layout, shrink the size-share of the current window" $
@@ -568,31 +577,31 @@ bindings = do
flip whenJust toggleWindowInSelection =<< withWindowSet (return . W.peek)
bind xK_m $ do
- justMod
- $ doc
+ justMod $
+ doc
"Mark the windows described by the window set with a given character.\n\n\t\
\For example, to mark the current window use <M-m>.<character>. That window\n\n\t\
\can then be recalled anywhere that requires a WML window.\n"
- $ do
- pushPendingBuffer "m " $ do
- locs <- fromMaybe [] <$> runMaybeT readNextLocationSet
- let wins = mapMaybe locationWindow locs
- unless (null wins) $ do
- withBorderColor selectedWindowsColor wins $ do
- runMaybeT_ $ do
- mapNextString $ \_ str -> lift $
- case str of
- [ch] | isAlpha ch -> markAllLocations str locs
- _ -> return ()
+ $ do
+ pushPendingBuffer "m " $ do
+ locs <- fromMaybe [] <$> runMaybeT readNextLocationSet
+ let wins = mapMaybe locationWindow locs
+ unless (null wins) $ do
+ withBorderColor selectedWindowsColor wins $ do
+ runMaybeT_ $ do
+ mapNextString $ \_ str -> lift $
+ case str of
+ [ch] | isAlpha ch -> markAllLocations str locs
+ _ -> return ()
bind xK_plus $ do
- justMod
- $ doc
+ justMod $
+ doc
"Increase the number of windows in the master region, or increase\n\t\
\the size of the master region if the current layout cannot have more\n\t\
\than one window in the master region.\n"
- $ sendMessage
- $ IncMasterN 1
+ $ sendMessage $
+ IncMasterN 1
shiftMod $
doc "For mosaic layout, increase the size-share of the current window." $
@@ -611,8 +620,8 @@ bindings = do
bind xK_s $ do
forM_ [(JustShift, justMod), (ShiftAndSwap, shiftMod), (ShiftAndFollow, controlMod)] $ \(shiftType, f) ->
- f
- $ doc
+ f $
+ doc
( case shiftType of
ShiftAndFollow ->
"Shift-and-follow: Like shift-and-swap with the implicit \
@@ -624,54 +633,54 @@ bindings = do
\Note that this command will only work with normal workspaces."
JustShift -> "Shift a windowset to a workspace"
)
- $ pushPendingBuffer
- ( case shiftType of
- ShiftAndSwap -> "S "
- JustShift -> "s "
- ShiftAndFollow -> "^s "
- )
- $ runMaybeT_
- $ do
- stackset <- lift $ X.windowset <$> X.get
- selection <- mapMaybe locationWindow <$> readNextLocationSet
- withBorderColorM selectedWindowsColor selection $ do
- lift $ addStringToPendingBuffer " "
- ws <- readNextWorkspace
- finalSwap <-
- case shiftType of
- ShiftAndSwap -> do
+ $ pushPendingBuffer
+ ( case shiftType of
+ ShiftAndSwap -> "S "
+ JustShift -> "s "
+ ShiftAndFollow -> "^s "
+ )
+ $ runMaybeT_ $
+ do
+ stackset <- lift $ X.windowset <$> X.get
+ selection <- mapMaybe locationWindow <$> readNextLocationSet
+ withBorderColorM selectedWindowsColor selection $ do
lift $ addStringToPendingBuffer " "
- wsName <- MaybeT . return $ workspaceName ws
- W.switchWorkspaces wsName <$> readNextWorkspaceName
- _ -> return id
-
- lift $ do
- (Endo allMovements) <-
- mconcat
- <$> mapM (fmap Endo . moveWindowToWorkspaceFn ws) selection
-
- setAlternateWindows selection
-
- forM_ selection $ \win -> do
- mapM_
- ( \t -> do
- logs Debug "Set alternate workspace %s -> %s" (show win) t
- setAlternateWorkspace win t
- )
- (W.findTag win stackset)
-
- withWindowsUnpinned selection $
- windows $
- finalSwap
- . ( \ss ->
- case shiftType of
- ShiftAndFollow
- | (w : _) <- selection,
- Just ws <- W.findTag w ss ->
- W.greedyView ws ss
- _ -> ss
- )
- . allMovements
+ ws <- readNextWorkspace
+ finalSwap <-
+ case shiftType of
+ ShiftAndSwap -> do
+ lift $ addStringToPendingBuffer " "
+ wsName <- MaybeT . return $ workspaceName ws
+ W.switchWorkspaces wsName <$> readNextWorkspaceName
+ _ -> return id
+
+ lift $ do
+ (Endo allMovements) <-
+ mconcat
+ <$> mapM (fmap Endo . moveWindowToWorkspaceFn ws) selection
+
+ setAlternateWindows selection
+
+ forM_ selection $ \win -> do
+ mapM_
+ ( \t -> do
+ logs Debug "Set alternate workspace %s -> %s" (show win) t
+ setAlternateWorkspace win t
+ )
+ (W.findTag win stackset)
+
+ withWindowsUnpinned selection $
+ windows $
+ finalSwap
+ . ( \ss ->
+ case shiftType of
+ ShiftAndFollow
+ | (w : _) <- selection,
+ Just ws <- W.findTag w ss ->
+ W.greedyView ws ss
+ _ -> ss
+ )
+ . allMovements
altMod $ spawnX "sudo -A systemctl suspend && xsecurelock"
@@ -743,25 +752,25 @@ bindings = do
doc "Toggles respect for struts." $
sendMessage ToggleStruts
- bind xK_g
- $ (noMod -|- justMod)
- $ doc
- "Switch to a different theater.\n\n\t\
- \Theaters are like super-workspaces. They are used for different\n\t\
- \'contexts'. Theaters share all the windows with eachother, but\n\t\
- \but each theater has its own mappings for window -> workspace. i.e.\n\t\
- \one theater can have window 'x' on workspace 'y', but another might\n\t\
- \have 'x' on 'z' instead. If a theater does explicity place a window,\n\t\
- \the window is placed in the hidden workspace (which is '*')\n"
- $ do
- addStringToPendingBuffer " g "
- runMaybeT_ $
- do
- mapNextString $ \_ str -> lift $
- case str of
- [ch] | isAlpha ch -> restoreTheater (Just [ch])
- [' '] -> restoreTheater Nothing
- _ -> return ()
+ bind xK_g $
+ (noMod -|- justMod) $
+ doc
+ "Switch to a different theater.\n\n\t\
+ \Theaters are like super-workspaces. They are used for different\n\t\
+ \'contexts'. Theaters share all the windows with eachother, but\n\t\
+ \but each theater has its own mappings for window -> workspace. i.e.\n\t\
+ \one theater can have window 'x' on workspace 'y', but another might\n\t\
+ \have 'x' on 'z' instead. If a theater does explicity place a window,\n\t\
+ \the window is placed in the hidden workspace (which is '*')\n"
+ $ do
+ addStringToPendingBuffer " g "
+ runMaybeT_ $
+ do
+ mapNextString $ \_ str -> lift $
+ case str of
+ [ch] | isAlpha ch -> restoreTheater (Just [ch])
+ [' '] -> restoreTheater Nothing
+ _ -> return ()
let spaceResize = repeatable $ do
bind xK_bracketright $ do
@@ -864,8 +873,8 @@ bindings = do
sendMessage togglePop
bind xK_F8 $ do
- justMod
- $ doc
+ justMod $
+ doc
"Set the log level.\n\
\Log levels are, in order\n\n\t\
\Trace\n\t\
@@ -875,15 +884,15 @@ bindings = do
\Error\n\t\
\Fatal\n\n\
\Log is sent to stdout."
- $ do
- ll <- getLogLevel
- let next = if minBound == ll then maxBound else pred ll
+ $ do
+ ll <- getLogLevel
+ let next = if minBound == ll then maxBound else pred ll
- safeSpawnX
- "notify-send"
- ["-t", "2000", printf "LogLevel set to %s" (show next)]
- setLogLevel next
- logs next "LogLevel set to %s." (show next)
+ safeSpawnX
+ "notify-send"
+ ["-t", "2000", printf "LogLevel set to %s" (show next)]
+ setLogLevel next
+ logs next "LogLevel set to %s." (show next)
bind xF86XK_Calculator $ do
noMod $
@@ -1142,25 +1151,25 @@ bindings = do
forM_ [(button7, ",.", "right"), (button6, ";.", "left")] $
\(b, mot, d) -> do
- bind b
- $ noMod
- $ doc
- ( "Move the selected windows to the workspace on the \
- \screen to the "
- ++ d
- )
- $ noWindow
- $ do
- wins <- getAndResetWindowSelection
- runMaybeT_ $ do
- ws' <- workspaceForStringT mot
- ws <- MaybeT . return $ workspaceName ws'
- lift $
- let f =
- appEndo
- ( mconcat (map (Endo . W.shiftWin ws) wins)
- )
- in windows f >> escape
+ bind b $
+ noMod $
+ doc
+ ( "Move the selected windows to the workspace on the \
+ \screen to the "
+ ++ d
+ )
+ $ noWindow $
+ do
+ wins <- getAndResetWindowSelection
+ runMaybeT_ $ do
+ ws' <- workspaceForStringT mot
+ ws <- MaybeT . return $ workspaceName ws'
+ lift $
+ let f =
+ appEndo
+ ( mconcat (map (Endo . W.shiftWin ws) wins)
+ )
+ in windows f >> escape
myMouseMoveWindow =
D.mouseMoveWindowAndThen X.focus $
diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index 5565c31..61c19b2 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -43,6 +43,7 @@ module Rahm.Desktop.Keys.Wml
locationSetForKeys,
readNextWorkspaceName,
workspaceName,
+ withNextWorkspaceOrKey,
)
where
@@ -75,6 +76,7 @@ import Data.Typeable (cast)
-- pastHistory,
+import Data.Void (Void, absurd)
import Rahm.Desktop.BorderColors (BorderColor (BorderColor), setBorderColor)
import Rahm.Desktop.Common
( Location (..),
@@ -438,148 +440,197 @@ lift1 = fmap (lift . fromX)
readNextWorkspaceName :: (KeyFeeder m) => MaybeT m WorkspaceId
readNextWorkspaceName = joinMaybe $ workspaceName <$> readNextWorkspace
--- Returns the next workspaces associated with the next set of keystrokes.
readNextWorkspace :: (KeyFeeder m) => MaybeT m Workspace
-readNextWorkspace =
+readNextWorkspace = unEither <$> readNextWorkspaceWithHandler (const doNothing)
+ where
+ doNothing :: (Monad m) => MaybeT m Void
+ doNothing = MaybeT (return Nothing)
+
+ unEither :: Either Void a -> a
+ unEither = either absurd id
+
+withNextWorkspaceOrKey ::
+ (KeyFeeder m) =>
+ (Workspace -> m ()) ->
+ ((KeyMask, KeySym, String) -> m ()) ->
+ MaybeT m ()
+withNextWorkspaceOrKey wFn kFn =
+ either (lift . kFn) (lift . wFn) =<< readNextWorkspaceWithHandler return
+
+-- Returns the next workspaces associated with the next set of keystrokes, or
+-- invokes the handler if the next stroke is not associated with WML command.
+readNextWorkspaceWithHandler :: (KeyFeeder m) => ((KeyMask, KeySym, String) -> MaybeT m b) -> MaybeT m (Either b Workspace)
+readNextWorkspaceWithHandler handle =
readNextKey $ \mask sym str -> do
macros <- (lift . fromX) $ workspaceMacros <$> getMacros
case (mask, sym, str) of
-- Escape kills the "readNextWorkspace" and returns nothing.
- (_, e, _) | e == xK_Escape -> MaybeT $ return Nothing
+ (_, e, _)
+ | e == xK_Escape ->
+ fmap Right $
+ MaybeT $ return Nothing
-- Macros takes precedence over everything.
- (mask, keysym, _) | (Just macro) <- Map.lookup (mask, keysym) macros -> do
- fromMaybeTX $ workspaceForKeysT macro
+ (mask, keysym, _) | (Just macro) <- Map.lookup (mask, keysym) macros ->
+ fmap Right $ do
+ fromMaybeTX $ workspaceForKeysT macro
-- A single alphanumeric character is the atomic reference to a workspace.
- (_, _, [ch]) | isAlphaNum ch || ch == '*' -> return $ justWorkspace [ch]
+ (_, _, [ch])
+ | isAlphaNum ch || ch == '*' ->
+ return $ Right $ justWorkspace [ch]
-- to the non-visible workspace left of the next workspace.
(_, _, "[") ->
- justWorkspace
- <$> ( lift1 (adjacentWorkspaceNotVisible prev)
- =<< readNextWorkspaceName
- )
+ fmap Right $
+ justWorkspace
+ <$> ( lift1 (adjacentWorkspaceNotVisible prev)
+ =<< readNextWorkspaceName
+ )
-- to the non-visible workspace right of the next workspace
(_, _, "]") ->
- justWorkspace
- <$> ( lift1 (adjacentWorkspaceNotVisible next)
- =<< readNextWorkspaceName
- )
+ fmap Right $
+ justWorkspace
+ <$> ( lift1 (adjacentWorkspaceNotVisible next)
+ =<< readNextWorkspaceName
+ )
-- To the left of the next workspace
(_, _, "(") ->
- justWorkspace
- <$> ( lift1 (adjacentWorkspace prev)
- =<< readNextWorkspaceName
- )
+ fmap Right $
+ justWorkspace
+ <$> ( lift1 (adjacentWorkspace prev)
+ =<< readNextWorkspaceName
+ )
-- To the right of the next workspace
(_, _, ")") ->
- justWorkspace
- <$> ( lift1 (adjacentWorkspace next)
- =<< readNextWorkspaceName
- )
+ fmap Right $
+ justWorkspace
+ <$> ( lift1 (adjacentWorkspace next)
+ =<< readNextWorkspaceName
+ )
-- The workspace on the leftmost screen
- (_, _, "^") -> mapMaybeT fromX $
- MaybeT $
- withWindowSet $ \ws ->
- return $
- ( fmap
- ( justWorkspace . W.tag . W.workspace . snd
+ (_, _, "^") ->
+ fmap Right $
+ mapMaybeT fromX $
+ MaybeT $
+ withWindowSet $ \ws ->
+ return $
+ ( fmap
+ ( justWorkspace . W.tag . W.workspace . snd
+ )
+ . head
)
- . head
- )
- (getHorizontallyOrderedScreens ws)
+ (getHorizontallyOrderedScreens ws)
-- The last workspace in history.
- (_, _, "'") -> fromMaybeTX $ justWorkspace . locationWorkspace <$> MaybeT lastLocation
+ (_, _, "'") ->
+ fmap Right $
+ fromMaybeTX $
+ justWorkspace . locationWorkspace <$> MaybeT lastLocation
-- The current workspace.
- (_, _, ".") -> mt $ justWorkspace <$> getCurrentWorkspace
+ (_, _, ".") ->
+ fmap Right $
+ mt $ justWorkspace <$> getCurrentWorkspace
-- The workspace on the rightmost screen
- (_, _, "$") -> MaybeT $
- fromX $
- withWindowSet $ \ws ->
- return $
- (fmap (justWorkspace . W.tag . W.workspace . snd) . last)
- (getHorizontallyOrderedScreens ws)
+ (_, _, "$") -> fmap Right $
+ MaybeT $
+ fromX $
+ withWindowSet $ \ws ->
+ return $
+ (fmap (justWorkspace . W.tag . W.workspace . snd) . last)
+ (getHorizontallyOrderedScreens ws)
-- Modify the next workspace as a "floating" workspace. (Windows sent to
-- it will float).
- (_, _, ":") -> floatWorkspace <$> readNextWorkspace
+ (_, _, ":") ->
+ fmap Right $
+ floatWorkspace <$> readNextWorkspace
-- Workspace to the next screen to the right of the next workspace.
- (_, _, ",") -> do
- ws <- readNextWorkspace
- screens <-
- mt $
- map (W.tag . W.workspace . snd)
- <$> withWindowSet (return . getHorizontallyOrderedScreens)
+ (_, _, ",") ->
+ fmap Right $ do
+ ws <- readNextWorkspace
+ screens <-
+ mt $
+ map (W.tag . W.workspace . snd)
+ <$> withWindowSet (return . getHorizontallyOrderedScreens)
- let (_, rest) = break ((== workspaceName ws) . Just) (screens ++ screens)
+ let (_, rest) = break ((== workspaceName ws) . Just) (screens ++ screens)
- justWorkspace <$> MaybeT (return $ head $ tail rest)
+ justWorkspace <$> MaybeT (return $ head $ tail rest)
-- Workspace to the next screen to the left of the next workspace.
- (_, _, ";") -> do
- ws <- readNextWorkspace
- screens <-
- mt $
- map (W.tag . W.workspace . snd)
- <$> withWindowSet (return . getHorizontallyOrderedScreens)
+ (_, _, ";") ->
+ fmap Right $ do
+ ws <- readNextWorkspace
+ screens <-
+ mt $
+ map (W.tag . W.workspace . snd)
+ <$> withWindowSet (return . getHorizontallyOrderedScreens)
- let (front, _) = break ((== workspaceName ws) . Just) (screens ++ screens)
+ let (front, _) = break ((== workspaceName ws) . Just) (screens ++ screens)
- justWorkspace <$> MaybeT (return $ last front)
+ justWorkspace <$> MaybeT (return $ last front)
-- The workspace with the searched for window.
- (_, _, "/") -> fromMaybeTX $ do
- justWorkspace <$> ((MaybeT . workspaceWithWindow) =<< MaybeT (head <$> askWindowId))
+ (_, _, "/") ->
+ fmap Right $
+ fromMaybeTX $ do
+ justWorkspace <$> ((MaybeT . workspaceWithWindow) =<< MaybeT (head <$> askWindowId))
-- The workspace with the next read window on it.
- (_, _, "@") -> do
- loc <- readNextLocationSet
- MaybeT $
- fromX $
- withWindowSet $ \ws -> return $ do
- win <- locationWindow =<< head loc
- winLocation <- W.findWindow ws win
- justWorkspaceWithPreferredWindow win . W.tag <$> W.getLocationWorkspace winLocation
+ (_, _, "@") ->
+ fmap Right $ do
+ loc <- readNextLocationSet
+ MaybeT $
+ fromX $
+ withWindowSet $ \ws -> return $ do
+ win <- locationWindow =<< head loc
+ winLocation <- W.findWindow ws win
+ justWorkspaceWithPreferredWindow win . W.tag <$> W.getLocationWorkspace winLocation
-- The accompaning worksapce to the next read workspace.
(_, _, "~") ->
- justWorkspace . accompaningWorkspace <$> readNextWorkspaceName
+ fmap Right $
+ justWorkspace . accompaningWorkspace <$> readNextWorkspaceName
-- The accompaning workspace to the current workspace (equivalent to ~.)
(_, _, " ") ->
- mt $
- justWorkspace . accompaningWorkspace <$> getCurrentWorkspace
+ fmap Right $
+ mt $
+ justWorkspace . accompaningWorkspace <$> getCurrentWorkspace
-- The balck hole workspace
- (_, _, "_") -> return blackHoleWorkspace
+ (_, _, "_") ->
+ return $ Right blackHoleWorkspace
-- The alternate workspace
- (_, _, "-") -> return alternateWorkspace
+ (_, _, "-") ->
+ return $ Right alternateWorkspace
-- If the next two read workspaces are equal, go to the third workspace
-- otherwise go to the fourth workspace.
- (_, _, "=") -> do
- ws1 <- readNextWorkspace
- ws2 <- readNextWorkspace
+ (_, _, "=") ->
+ fmap Right $ do
+ ws1 <- readNextWorkspace
+ ws2 <- readNextWorkspace
- ws3 <- readNextWorkspace
- ws4 <- readNextWorkspace
+ ws3 <- readNextWorkspace
+ ws4 <- readNextWorkspace
- return $
- if workspaceName ws1 == workspaceName ws2
- then ws3
- else ws4
+ return $
+ if workspaceName ws1 == workspaceName ws2
+ then ws3
+ else ws4
-- If the next read location set is not empty, go to the next read
-- workspace, otherwise go to the next-next read workspace.
- (_, _, "?") -> do
- l1 <- readNextLocationSet
+ (_, _, "?") ->
+ fmap Right $ do
+ l1 <- readNextLocationSet
- ws1 <- readNextWorkspace
- ws2 <- readNextWorkspace
+ ws1 <- readNextWorkspace
+ ws2 <- readNextWorkspace
- mt $ logs Trace "If not empty %s then %s else %s" (show l1) (show $ workspaceName ws1) (show $ workspaceName ws2)
+ mt $ logs Trace "If not empty %s then %s else %s" (show l1) (show $ workspaceName ws1) (show $ workspaceName ws2)
- return $
- if null l1
- then ws2
- else ws1
- _ -> MaybeT (return Nothing)
+ return $
+ if null l1
+ then ws2
+ else ws1
+ _ -> Left <$> handle (mask, sym, str)
where
mt :: (KeyFeeder m) => X a -> MaybeT m a
mt = lift . fromX
@@ -659,7 +710,7 @@ readNextLocationSet' =
-- Windows in a workspace
(_, _, s)
| s == "\t" || s == "@" || s == "\n" ->
- (mt . windowsInWorkspace) =<< readNextWorkspaceName
+ (mt . windowsInWorkspace) =<< readNextWorkspaceName
-- The first window in the next window set.
(_, _, "!") -> (: []) <$> joinMaybe (head <$> readNextLocationSet)
-- The windows except the first in a window set.
generated by cgit (git 2.34.1) at 2026-02-22 15:08:12 +0000