aboutsummaryrefslogtreecommitdiff
path: root/src/Rahm/Desktop
diff options
context:
space:
mode:
authorJosh Rahm <rahm@google.com>2023-12-08 16:13:52 -0700
committerJosh Rahm <rahm@google.com>2023-12-08 16:13:52 -0700
commit718d69736e5dfd946648e7a305c15281d9656466 (patch)
tree0aa849edd4736d6b0c9bd1865a9ea09dd935ebd8 /src/Rahm/Desktop
parent87b103a4995fd2b6bbd1e72c446fd789caf5a050 (diff)
downloadrde-718d69736e5dfd946648e7a305c15281d9656466.tar.gz
rde-718d69736e5dfd946648e7a305c15281d9656466.tar.bz2
rde-718d69736e5dfd946648e7a305c15281d9656466.zip
Revert "Experimental ability to pin a window using Mod+p"
This reverts commit 87b103a4995fd2b6bbd1e72c446fd789caf5a050.
Diffstat (limited to 'src/Rahm/Desktop')
-rw-r--r--src/Rahm/Desktop/History.hs65
-rw-r--r--src/Rahm/Desktop/Hooks/WindowChange.hs11
-rw-r--r--src/Rahm/Desktop/Keys.hs390
-rw-r--r--src/Rahm/Desktop/PinWindow.hs101
-rw-r--r--src/Rahm/Desktop/StackSet.hs8
5 files changed, 223 insertions, 352 deletions
diff --git a/src/Rahm/Desktop/History.hs b/src/Rahm/Desktop/History.hs
index d1a4bb9..ffcb10e 100644
--- a/src/Rahm/Desktop/History.hs
+++ b/src/Rahm/Desktop/History.hs
@@ -58,7 +58,7 @@ zipperDbgPrint _ = "<empty>"
pushZipper :: a -> BoundedSeqZipper a -> BoundedSeqZipper a
pushZipper e (BoundedSeqZipper maxSize _ (tail :|> _))
| maxSize <= Seq.length tail =
- BoundedSeqZipper maxSize mempty (e :<| tail)
+ BoundedSeqZipper maxSize mempty (e :<| tail)
pushZipper e (BoundedSeqZipper maxSize _ tail) =
BoundedSeqZipper maxSize mempty (e :<| tail)
@@ -133,44 +133,44 @@ data ScreenDiff = ScreenDiff
newLocation :: Location
}
-historyHook :: StackChangeHook
+historyHook :: WindowStack -> WindowStack -> X ()
-- History hook where the 'from' location workspace does not match the 'to'
-- location workspace.
-historyHook = StackChangeHook $ \lastWindowSet currentWindowSet -> do
+historyHook lastWindowSet currentWindowSet = do
(History hist) <- XS.get
forM_ (getScreenDiffs lastWindowSet currentWindowSet) $
-- Read as "the screen <sid> went from <oloc> to <nloc>"
\(ScreenDiff sid oloc nloc) ->
let (ows, nws) = (locationWorkspace oloc, locationWorkspace nloc)
- in -- The goal here is to preserve history in as intuitive a way as possible
- -- When the stackset changes, for each screen that changed in the last
- -- windowchange, one of 2 situations are possibel:
- --
- -- 1. The workspace on the screen was swapped with an already visible
- -- screen
- --
- -- 2. The workspace on the screen was swapped with a hidden workspace.
- --
- -- In the case of 1, we want to treat it as if the screen was
- -- "reseated" to a different monitor, preserving the history for that
- -- screen on its new screen.
- --
- -- In case of 2, we want to add the old workspace to the history of the
- -- screen that changed.
- case () of
- ()
- | nws `visibleIn` lastWindowSet,
- (Just oscr) <- screenOf nws lastWindowSet ->
- -- The last workspace was on a different screen. Swap the current
- -- screen's history with the history from the last screen the
- -- workspace was on.
- XS.modify $ \(History byScreen) ->
- History
- ( Map.alter
- (const $ Map.lookup oscr hist)
- sid
- byScreen
- )
+
+ -- The goal here is to preserve history in as intuitive a way as possible
+ -- When the stackset changes, for each screen that changed in the last
+ -- windowchange, one of 2 situations are possibel:
+ --
+ -- 1. The workspace on the screen was swapped with an already visible
+ -- screen
+ --
+ -- 2. The workspace on the screen was swapped with a hidden workspace.
+ --
+ -- In the case of 1, we want to treat it as if the screen was
+ -- "reseated" to a different monitor, preserving the history for that
+ -- screen on its new screen.
+ --
+ -- In case of 2, we want to add the old workspace to the history of the
+ -- screen that changed.
+ in case () of
+ () | nws `visibleIn` lastWindowSet,
+ (Just oscr) <- screenOf nws lastWindowSet ->
+ -- The last workspace was on a different screen. Swap the current
+ -- screen's history with the history from the last screen the
+ -- workspace was on.
+ XS.modify $ \(History byScreen) ->
+ History
+ ( Map.alter
+ (const $ Map.lookup oscr hist)
+ sid
+ byScreen
+ )
-- The new workspace was not originally visible, add to history
() | not (nws `visibleIn` lastWindowSet) ->
XS.modify $ \(History byScreen) ->
@@ -180,6 +180,7 @@ historyHook = StackChangeHook $ \lastWindowSet currentWindowSet -> do
sid
byScreen
)
+
-- This is typically not a possible case. It's only possible when a
-- screen is unplugged. If that's the case, do nothing.
_ -> return ()
diff --git a/src/Rahm/Desktop/Hooks/WindowChange.hs b/src/Rahm/Desktop/Hooks/WindowChange.hs
index 0902f53..32c854b 100644
--- a/src/Rahm/Desktop/Hooks/WindowChange.hs
+++ b/src/Rahm/Desktop/Hooks/WindowChange.hs
@@ -26,18 +26,11 @@ import qualified XMonad.Util.ExtensibleState as XS (get, put)
type WindowStack = StackSet WorkspaceId () Window ScreenId ScreenDetail
-- Type of hook. Takes the last WindowStack and the new WindowStack
-newtype StackChangeHook = StackChangeHook (WindowStack -> WindowStack -> X ())
+type StackChangeHook = WindowStack -> WindowStack -> X ()
newtype LastState = LastState (Maybe WindowStack)
deriving (Read, Show)
-instance Semigroup StackChangeHook where
- StackChangeHook f1 <> StackChangeHook f2 =
- StackChangeHook $ \l c -> f1 l c >> f2 l c
-
-instance Monoid StackChangeHook where
- mempty = StackChangeHook $ \_ _ -> return ()
-
instance Default LastState where
def = LastState def
@@ -52,7 +45,7 @@ instance ExtensionClass LastState where
--
-- If the first window is Nothing, this is the first time XMonad started.
withStackChangeHook :: StackChangeHook -> XConfig l -> XConfig l
-withStackChangeHook (StackChangeHook fn) config =
+withStackChangeHook fn config =
config
{ logHook = do
logHook config
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index f508155..76634b0 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -42,7 +42,6 @@ import Graphics.X11.ExtraTypes.XF86
import Rahm.Desktop.Common
( Location (..),
click,
- duplWindow,
focusLocation,
getCurrentWorkspace,
gotoWorkspace,
@@ -52,7 +51,7 @@ import Rahm.Desktop.Common
runMaybeT_,
setBorderColor,
withBorderColor,
- withBorderColorM,
+ withBorderColorM, duplWindow,
)
import Rahm.Desktop.DMenu (runDMenu)
import qualified Rahm.Desktop.Dragging as D
@@ -132,7 +131,6 @@ import Rahm.Desktop.Marking
setAlternateWorkspace,
)
import Rahm.Desktop.PassMenu (runPassMenu)
-import Rahm.Desktop.PinWindow (togglePinWindow)
import Rahm.Desktop.RebindKeys
( remapKey,
sendKey,
@@ -309,7 +307,7 @@ keymap = runKeys $ do
justMod $
doc "Run the command which opened this window again." $
X.withFocused duplWindow
-
+
bind xK_w $ do
justMod $
doc "Swap windows with other windows" $
@@ -328,20 +326,19 @@ 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 "#00ffff" 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 "#00ffff" 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
@@ -449,8 +446,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\
@@ -469,58 +466,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 $
@@ -570,22 +567,14 @@ keymap = runKeys $ do
doc "Lock the screen" $
spawnX "xsecurelock"
- bind xK_p $ do
- justMod $
- doc "Pin a window to the screen" $
- pushPendingBuffer "p " $ do
- runMaybeT_ $ do
- wins <- mapMaybe locationWindow <$> readNextLocationSet
- lift $ mapM_ togglePinWindow wins
-
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" $
@@ -620,31 +609,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 "#00ffff" 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 "#00ffff" 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." $
@@ -663,8 +652,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 \
@@ -676,54 +665,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 "#00ffff" 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 "#00ffff" 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)
-
- 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)
+
+ 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"
@@ -778,25 +767,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
@@ -828,24 +817,23 @@ 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 $
@@ -916,8 +904,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\
@@ -927,15 +915,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"
@@ -1069,8 +1057,8 @@ mouseMap = runButtons $ do
subMouse $ do
bind button3 $
noMod $
- doc "Drag a workspace to another screen." $
- noWindow D.dragWorkspace
+ doc "Move to workspace 's' (Spotify)" $
+ noWindow (gotoWorkspace "s")
bind button1 $
noMod $
@@ -1188,8 +1176,7 @@ 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 $
@@ -1217,25 +1204,24 @@ 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
let workspaceButtons =
[ ( button2,
diff --git a/src/Rahm/Desktop/PinWindow.hs b/src/Rahm/Desktop/PinWindow.hs
deleted file mode 100644
index b4699aa..0000000
--- a/src/Rahm/Desktop/PinWindow.hs
+++ /dev/null
@@ -1,101 +0,0 @@
-module Rahm.Desktop.PinWindow where
-
-import Control.Monad.RWS (Endo (Endo, appEndo), forM_)
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Set (Set)
-import qualified Data.Set as Set
-import Rahm.Desktop.Common (setBorderColor)
-import Rahm.Desktop.Hooks.WindowChange (StackChangeHook (..))
-import qualified Rahm.Desktop.StackSet as W
-import XMonad (Default (..), ExtensionClass (..), StateExtension (PersistentExtension), Window, X, XState (windowset), getScreenSaver)
-import qualified XMonad as X
-import qualified XMonad.Util.ExtensibleState as XS
-
-newtype PinWindowState = PinWindowState (Set Window)
- deriving (Read, Show)
-
-instance Default PinWindowState where
- def = PinWindowState mempty
-
-instance ExtensionClass PinWindowState where
- initialValue = def
- extensionType = PersistentExtension
-
-focPinColor = "#40ff40"
-
-pinColor = "#80a080"
-
-togglePinWindow :: Window -> X ()
-togglePinWindow w = do
- foc <- X.withWindowSet (return . W.peek)
- (fc, nc) <-
- (,)
- <$> X.asks (X.focusedBorderColor . X.config)
- <*> X.asks (X.normalBorderColor . X.config)
-
- (PinWindowState s) <- XS.get
- let (del, s') =
- ( if Set.member w s
- then (True, Set.delete w s)
- else (False, Set.insert w s)
- )
-
- bc = case (Just w == foc, del) of
- (True, True) -> fc
- (False, True) -> nc
- (False, False) -> pinColor
- (True, False) -> focPinColor
-
- _ <- setBorderColor bc [w]
- XS.put (PinWindowState s')
-
-pinWindowBorderUpdate :: X ()
-pinWindowBorderUpdate = do
- (PinWindowState s) <- XS.get
- foc <- X.withWindowSet (return . W.peek)
- forM_ (Set.toList s) $ \w -> do
- let bc = if Just w == foc then focPinColor else pinColor
- _ <- setBorderColor bc [w]
- return ()
-
-pinWindowChangeHook :: StackChangeHook
-pinWindowChangeHook = StackChangeHook $ \last current -> do
- (PinWindowState s) <- XS.get
- let lastVisible = visiblePinnedWindows s last
- currentVisible = visiblePinnedWindows s current
- diff = Map.difference lastVisible currentVisible
- scrUpdates = Map.elems $ screenUpdates last current
-
- X.windows $
- foldl
- ( \fn (ow, nw) ->
- let l =
- map (Endo . W.shiftWinNoFocus nw) $
- filter (`Set.member` s) (W.windowsOnWorkspace ow last)
- in appEndo (mconcat l) . fn
- )
- id
- scrUpdates
- where
- screenUpdates :: (Ord si, Eq i) => W.StackSet i l a si sd -> W.StackSet i l a si sd -> Map si (i, i)
- screenUpdates (W.StackSet c1 v1 _ _) (W.StackSet c2 v2 _ _) =
- let makeMap = Map.fromList . map (\s -> (W.screen s, W.tag $ W.workspace s))
- m1 = makeMap (c1 : v1)
- m2 = makeMap (c2 : v2)
- in foldl
- ( \m' (k, w1) ->
- case Map.lookup k m2 of
- Just w2 | w1 == w2 -> m'
- Just w2 -> Map.insert k (w1, w2) m'
- _ -> Map.insert k (w1, w1) m'
- )
- mempty
- (Map.assocs m1)
-
- visiblePinnedWindows :: (Ord a) => Set a -> W.StackSet i l a si sd -> Map a si
- visiblePinnedWindows pinned (W.StackSet cur vis _ _) =
- Map.fromList $
- flip concatMap (cur : vis) $ \scr -> do
- let onScr = filter (`Set.member` pinned) $ W.integrate' $ W.stack $ W.workspace scr
- in map (,W.screen scr) onScr
diff --git a/src/Rahm/Desktop/StackSet.hs b/src/Rahm/Desktop/StackSet.hs
index 4ac00e4..2dc8787 100644
--- a/src/Rahm/Desktop/StackSet.hs
+++ b/src/Rahm/Desktop/StackSet.hs
@@ -2,7 +2,6 @@ module Rahm.Desktop.StackSet
( masterWindow,
allVisibleWindows,
differentiateWithFocus,
- shiftWinNoFocus,
concatMapTiledWindows,
windowsOnWorkspace,
findWorkspace,
@@ -202,13 +201,6 @@ greedyView wid ss = switchWorkspaces (tag . workspace . current $ ss) wid ss
shiftWin :: (Ord a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd
shiftWin wid a = XMonad.StackSet.shiftWin wid a . fst . ensureWorkspace wid
-shiftWinNoFocus :: (Ord a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd
-shiftWinNoFocus n w s = case findTag w s of
- Just from | n `tagMember` s && n /= from -> go from s
- _ -> s
- where go from = onWorkspace n (focusDown . insertUp w) . onWorkspace from (delete' w)
- onWorkspace n f s = view (currentTag s) . f . view n $ s
-
windowsOnWorkspace :: (Eq i) => i -> StackSet i l a s sd -> [a]
windowsOnWorkspace i ss = fromMaybe [] $ do
ws <- find ((== i) . W.tag) (W.workspaces ss)