aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Rahm/Desktop/Keys.hs403
-rw-r--r--src/Rahm/Desktop/Workspaces.hs27
2 files changed, 233 insertions, 197 deletions
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 3f3427d..ea2cde4 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -39,6 +39,7 @@ import Graphics.X11.ExtraTypes.XF86
xF86XK_MonBrightnessDown,
xF86XK_MonBrightnessUp,
)
+import Rahm.Desktop.BorderColors (BorderColor (BorderColor), withBorderColor, withBorderColorM)
import Rahm.Desktop.Common
( Location (..),
click,
@@ -48,6 +49,7 @@ import Rahm.Desktop.Common
gotoWorkspace,
locationWindow,
locationWorkspace,
+ pointerWindow,
pointerWorkspace,
runMaybeT_,
)
@@ -150,6 +152,7 @@ import Rahm.Desktop.Workspaces
next,
prev,
viewAdjacent,
+ viewAdjacentTo,
withScreen,
)
import Rahm.Desktop.XMobarLog.PendingBuffer
@@ -172,7 +175,6 @@ import XMonad.Layout.Spacing
import XMonad.Util.Run (safeSpawn)
import XMonad.Util.WindowProperties
import Prelude hiding ((!!))
-import Rahm.Desktop.BorderColors (withBorderColorM, withBorderColor, BorderColor (BorderColor), BorderColor (BorderColor))
type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
@@ -301,7 +303,8 @@ keymap = runKeys $ do
ifM
D.isDragging
(D.finishDrag >> withFocused D.sinkByWindowUnderCursor)
- $ pushPendingBuffer "' " $ do
+ $ pushPendingBuffer "' "
+ $ do
runMaybeT_ $ do
l <- readNextLocationSet'
case l of
@@ -333,19 +336,20 @@ keymap = runKeys $ 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
@@ -453,8 +457,8 @@ keymap = runKeys $ 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\
@@ -473,58 +477,58 @@ keymap = runKeys $ 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
+ $ pushPendingBuffer "g "
+ $ runMaybeT_
+ $ (lift . gotoWorkspaceFn) =<< readNextWorkspace
- shiftMod $
- doc
+ 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." $
subkeys $ 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 $
@@ -591,13 +595,13 @@ keymap = runKeys $ 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" $
@@ -632,31 +636,31 @@ keymap = runKeys $ 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." $
@@ -675,8 +679,8 @@ keymap = runKeys $ 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 \
@@ -688,55 +692,54 @@ keymap = runKeys $ 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
+ $ 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
lift $ addStringToPendingBuffer " "
- 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
+ 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"
@@ -791,25 +794,25 @@ keymap = runKeys $ do
sendMessage resetHole
logs Debug "/reset hole"
- 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
@@ -842,23 +845,24 @@ keymap = runKeys $ do
doc "Spawn a floating terminal" $
spawnX (terminal config ++ " -t Floating\\ Term")
- bind xK_v $
+ bind xK_v
+ $
-- Allows repeated strokes of M-h and M-l to reduce and increase volume
-- respectively.
- justMod $
- doc
- "Allows repeated strokes of M-h and M-l to decrease and\n\
- \increase volume respectively"
- $ repeatable $
- do
- bind xK_h $
- justMod decreaseVolumeDoc
+ justMod
+ $ doc
+ "Allows repeated strokes of M-h and M-l to decrease and\n\
+ \increase volume respectively"
+ $ repeatable
+ $ do
+ bind xK_h $
+ justMod decreaseVolumeDoc
- bind xK_l $
- justMod increaseVolumeDoc
+ bind xK_l $
+ justMod increaseVolumeDoc
- bind xK_v $
- justMod (return () :: X ())
+ bind xK_v $
+ justMod (return () :: X ())
bind xK_x $ do
justMod $
@@ -929,8 +933,8 @@ keymap = runKeys $ 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\
@@ -940,15 +944,15 @@ keymap = runKeys $ 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 $ spawnX $ terminal config ++ " -t Floating\\ Term -e /usr/bin/env python3"
@@ -1113,8 +1117,8 @@ mouseMap = runButtons $ do
[ (button4, "Increase volume", noWindow increaseVolume),
(button5, "Decrease volume", noWindow decreaseVolume),
(button2, "Play/Pause", noWindow playPause),
- (button9, "History Forward", noWindow historyForward),
- (button8, "History Back", noWindow historyBack),
+ (button9, "History Forward", noWindow (viewAdjacentTo pointerWorkspace next)),
+ (button8, "History Back", noWindow (viewAdjacentTo pointerWorkspace prev)),
(button6, "Media Previous", noWindow mediaPrev),
(button7, "Media Next", noWindow mediaNext)
]
@@ -1204,7 +1208,8 @@ mouseMap = runButtons $ do
bind button2 $
noMod $
- doc "Clear the window selection" $ noWindow (clearWindowSelection >> escape)
+ doc "Clear the window selection" $
+ noWindow (clearWindowSelection >> escape)
bind button13 $
noMod $
@@ -1214,6 +1219,25 @@ mouseMap = runButtons $ do
forM_ windows X.killWindow
escape
+ bind button14 $
+ noMod $
+ subMouse $ do
+ bind button1 $
+ noMod $
+ doc "Pin the selected windows" $
+ noWindow $ do
+ wins <- getAndResetWindowSelection
+ mapM_ pinWindow wins
+ escape
+
+ bind button3 $
+ noMod $
+ doc "Unpin the selected windows" $
+ noWindow $ do
+ wins <- getAndResetWindowSelection
+ mapM_ unpinWindow wins
+ escape
+
bind button3 $
noMod $
doc "Move all the windows to the workspace the pointer is on" $
@@ -1232,24 +1256,25 @@ mouseMap = runButtons $ 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
-- Bindings specific to a window. These are set similarly to th ekeymap above,
-- but uses a Query monad to tell which windows the keys will apply to.
diff --git a/src/Rahm/Desktop/Workspaces.hs b/src/Rahm/Desktop/Workspaces.hs
index 4763e26..6f0c08a 100644
--- a/src/Rahm/Desktop/Workspaces.hs
+++ b/src/Rahm/Desktop/Workspaces.hs
@@ -11,6 +11,7 @@ module Rahm.Desktop.Workspaces
adjacentWorkspaceNotVisible,
adjacentWorkspace,
viewAdjacent,
+ viewAdjacentTo,
adjacentScreen,
withScreen,
workspaceWithWindow,
@@ -19,17 +20,15 @@ module Rahm.Desktop.Workspaces
where
import Control.Arrow (Arrow ((&&&)))
+import Control.Monad.Trans (lift)
+import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
import Data.Char (isUpper, toLower, toUpper)
-import Data.List (find, sort, sortBy, sortOn)
+import Data.List (find, sort, sortBy, sortOn, (\\))
import Data.List.Safe ((!!))
import Data.Maybe (fromMaybe, mapMaybe)
-import Rahm.Desktop.Common (getCurrentWorkspace, gotoWorkspace)
+import Rahm.Desktop.Common (getCurrentWorkspace, gotoWorkspace, runMaybeT_)
+import Rahm.Desktop.Logger
import qualified Rahm.Desktop.StackSet as W
- ( Screen (Screen, screenDetail, workspace),
- StackSet (StackSet, current, visible),
- Workspace (Workspace, tag),
- integrate',
- )
import XMonad
( Rectangle (Rectangle),
ScreenDetail (SD),
@@ -41,7 +40,6 @@ import XMonad
windows,
withWindowSet,
)
-
import Prelude hiding ((!!))
newtype Selector = Selector (forall a. (a -> Bool) -> [a] -> Maybe a)
@@ -132,6 +130,19 @@ viewAdjacent :: Selector -> X ()
viewAdjacent sel =
gotoWorkspace =<< (adjacentWorkspaceNotVisible sel =<< getCurrentWorkspace)
+viewAdjacentTo :: X (Maybe WorkspaceId) -> Selector -> X ()
+viewAdjacentTo wsM (Selector sel) = runMaybeT_ $ do
+ lift $ logs Debug "viewAdjacentTo"
+ tag <- MaybeT wsM
+ lift $ logs Debug "from: %s" tag
+ ws <- MaybeT $ withWindowSet $ \ws ->
+ let vis = map (W.tag . W.workspace) (W.screens ws)
+ allW = sort $ map (W.tag . snd) (getPopulatedWorkspaces ws)
+ final = allW \\ (vis \\ [tag])
+ in return $ sel (== tag) final
+ lift $ logs Debug "to: %s" ws
+ lift $ windows $ W.switchWorkspaces tag ws
+
adjacentScreen :: Selector -> X WorkspaceId
adjacentScreen (Selector f) = do
(screens, current) <-
generated by cgit (git 2.34.1) at 2026-02-22 13:58:23 +0000