Implement new <M-/> binding which displays which workspace is on each screen

This uses Dzen to display this, so that's a new dependency.

1 files changed, 245 insertions, 213 deletions

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 971cdd3..8be81f6 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -28,6 +28,7 @@ import Data.Maybe
     mapMaybe,
   )
 import Data.Monoid (Endo (..))
+import GHC.IO.Handle (hClose, hFlush)
 import Graphics.X11.ExtraTypes.XF86
   ( xF86XK_AudioLowerVolume,
     xF86XK_AudioMute,
@@ -71,6 +72,7 @@ import Rahm.Desktop.Layout.ConsistentMosaic
   ( expandPositionAlt,
     shrinkPositionAlt,
   )
+import Rahm.Desktop.Layout.Explode (toggleExplode, toggleExplodeM)
 import Rahm.Desktop.Layout.Flip
   ( flipHorizontally,
     flipVertically,
@@ -97,10 +99,12 @@ import Rahm.Desktop.Marking
     setAlternateWorkspace,
   )
 import Rahm.Desktop.PassMenu (runPassMenu)
+import Rahm.Desktop.PopupTerminal (movePopupToCurrentWorkspace, movePopupToHiddenWorkspace)
 import Rahm.Desktop.RebindKeys
   ( remapKey,
     sendKey,
   )
+import Rahm.Desktop.StackSet (screens)
 import qualified Rahm.Desktop.StackSet as W
 import Rahm.Desktop.Submap
   ( escape,
@@ -138,11 +142,9 @@ import XMonad.Layout.Spacing
   ( Border (..),
     SpacingModifier (..),
   )
-import XMonad.Util.Run (safeSpawn)
+import XMonad.Util.Run (safeSpawn, hPutStrLn, spawnPipe)
 import XMonad.Util.WindowProperties
 import Prelude hiding ((!!))
-import Rahm.Desktop.Layout.Explode (toggleExplode, toggleExplodeM)
-import Rahm.Desktop.PopupTerminal (movePopupToCurrentWorkspace, movePopupToHiddenWorkspace)
 
 type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
 
@@ -267,13 +269,13 @@ bindings = do
         ifM
           D.isDragging
           (D.finishDrag >> withFocused D.sinkByWindowUnderCursor)
-          $ pushPendingBuffer "' " $
-            do
-              runMaybeT_ $ do
-                l <- runKeyFeed readNextLocationSet'
-                case l of
-                  (h : _) -> lift (focusLocation h)
-                  _ -> return ()
+          $ pushPendingBuffer "' "
+          $ do
+            runMaybeT_ $ do
+              l <- runKeyFeed readNextLocationSet'
+              case l of
+                (h : _) -> lift (focusLocation h)
+                _ -> return ()
     shiftMod $
       doc "Drag workspace to another." D.dragWindow
 
@@ -300,19 +302,19 @@ 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
-            runMaybeT_ $ do
-              w1 <- runKeyFeed readNextWorkspaceName
-              wins <- lift $ W.windowsOnWorkspace w1 <$> gets windowset
-              withBorderColorM selectedWindowsColor wins $ do
-                lift $ addStringToPendingBuffer " "
-                w2 <- runKeyFeed readNextWorkspaceName
-                lift $ windows $ W.swapWorkspaces w1 w2
+      $ pushPendingBuffer "W "
+      $ do
+        runMaybeT_ $ do
+          w1 <- runKeyFeed readNextWorkspaceName
+          wins <- lift $ W.windowsOnWorkspace w1 <$> gets windowset
+          withBorderColorM selectedWindowsColor wins $ do
+            lift $ addStringToPendingBuffer " "
+            w2 <- runKeyFeed readNextWorkspaceName
+            lift $ windows $ W.swapWorkspaces w1 w2
 
   bind xK_BackSpace $ do
     -- Moves xmobar to different monitors.
@@ -340,12 +342,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 $
@@ -398,16 +400,20 @@ bindings = do
     shiftMod $
       doc "Kill the current window" CopyWindow.kill1
 
-  bind xK_f $ do
+  bind xK_slash $
     justMod $
-      doc
+      doc "Discover the workspaces on each screen" screenDiscovery
+
+  bind xK_f $ do
+    justMod
+      $ doc
         "Focus (non-greedily) a workspace. Useful for focusing between \
         \screens with ',.', '$', '^', etc."
-        $ pushPendingBuffer "f " $
-          do
-            runMaybeT_ $ do
-              ws <- runKeyFeed readNextWorkspaceName
-              lift $ windows $ W.view ws
+      $ pushPendingBuffer "f "
+      $ do
+        runMaybeT_ $ do
+          ws <- runKeyFeed readNextWorkspaceName
+          lift $ windows $ W.view ws
 
   bind xK_a $ do
     justMod $
@@ -425,8 +431,8 @@ bindings = do
           lift $ windows $ W.view ws
 
   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\
@@ -445,70 +451,70 @@ 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"
-        $ subbind $
-          do
-            bind xK_F1 $
-              (noMod -|- justMod) $ do
-                doc <- getDoc
-                safeSpawn "gxmessage" ["-fn", "Source Code Pro", doc]
-
-            bind xK_F5 $
-              (noMod -|- justMod) $
-                spawnX "xmonad --recompile && xmonad --restart"
-
-            bindOtherKeys $ \key -> execKeyFeed $ do
-              pushKey key
-              ws <- readNextWorkspace
-              liftXToFeed $ gotoWorkspaceFn ws
-
-    shiftMod $
-      doc
+      $ subbind
+      $ do
+        bind xK_F1 $
+          (noMod -|- justMod) $ do
+            doc <- getDoc
+            safeSpawn "gxmessage" ["-fn", "Source Code Pro", doc]
+
+        bind xK_F5 $
+          (noMod -|- justMod) $
+            spawnX "xmonad --recompile && xmonad --restart"
+
+        bindOtherKeys $ \key -> execKeyFeed $ do
+          pushKey key
+          ws <- readNextWorkspace
+          liftXToFeed $ gotoWorkspaceFn ws
+
+    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 <- runKeyFeed readNextWorkspaceName
-              lift $ addStringToPendingBuffer " "
-              w2 <- runKeyFeed readNextWorkspaceName
-              lift $ windows $ W.switchWorkspaces w1 w2
+      $ do
+        pushPendingBuffer "G " $ do
+          runMaybeT_ $ do
+            w1 <- runKeyFeed readNextWorkspaceName
+            lift $ addStringToPendingBuffer " "
+            w2 <- runKeyFeed 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 $
@@ -579,13 +585,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" $
@@ -624,31 +630,31 @@ bindings = do
       mod2Mask
       (logs Info "Testing Mod2Mask" :: X ())
 
-    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 [] <$> runKeyFeedX 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 [] <$> runKeyFeedX 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." $
@@ -672,8 +678,8 @@ bindings = do
         (ShiftAndFollow, controlMod)
       ]
       $ \(shiftType, f) ->
-        f $
-          doc
+        f
+          $ doc
             ( case shiftType of
                 ShiftAndFollow ->
                   "Shift-and-follow: Like shift-and-swap with the implicit \
@@ -685,54 +691,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 <$> runKeyFeed 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 <$> runKeyFeed readNextLocationSet
+            withBorderColorM selectedWindowsColor selection $ do
+              lift $ addStringToPendingBuffer " "
+              ws <- runKeyFeed readNextWorkspace
+              finalSwap <-
+                case shiftType of
+                  ShiftAndSwap -> do
                     lift $ addStringToPendingBuffer " "
-                    ws <- runKeyFeed readNextWorkspace
-                    finalSwap <-
-                      case shiftType of
-                        ShiftAndSwap -> do
-                          lift $ addStringToPendingBuffer " "
-                          wsName <- MaybeT . return $ workspaceName ws
-                          W.switchWorkspaces wsName <$> runKeyFeed 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 <$> runKeyFeed 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"
 
@@ -789,25 +795,25 @@ bindings = do
               doc "Jump to the middle layout." $
                 sendMessage (toIndexedLayout (nLayouts `div` 2))
 
-          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 ()
 
           bind xK_x $ do
             shiftMod $
@@ -915,10 +921,11 @@ bindings = do
           bind xK_c $ do
             noMod -|- justMod $
               doc "Toggle explode on the workspace" $ do
-                sendMessage (toggleExplodeM
-                     movePopupToCurrentWorkspace
-                     movePopupToHiddenWorkspace)
-
+                sendMessage
+                  ( toggleExplodeM
+                      movePopupToCurrentWorkspace
+                      movePopupToHiddenWorkspace
+                  )
 
           bindOtherKeys $ \(_, _, s) ->
             logs Info "Unhandled key pressed: %s" s
@@ -933,8 +940,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\
@@ -944,15 +951,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 $
@@ -1220,25 +1227,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
 
   -- Keycode Bindings.
   --
@@ -1336,12 +1343,11 @@ windowSpecificBindings config = do
       bind kcU $
         rawMask mod3Mask $
           emitKey (controlMask .|. shiftMask, xK_Tab)
-          
+
       bind kcO $
         rawMask mod3Mask $
           emitKey (controlMask, xK_Tab)
 
-
     forM_ [0, shiftMask] $ \m -> do
       bind xK_braceleft $
         rawMask (m .|. mod3Mask) $
@@ -1437,7 +1443,7 @@ windowSpecificBindings config = do
       noMod $
         emitKey (controlMask, xK_F2)
   where
-    browsers = [(=="Google-chrome"), (=="Brave-browser"), ("firefox"`isInfixOf`) . map toLower]
+    browsers = [(== "Google-chrome"), (== "Brave-browser"), ("firefox" `isInfixOf`) . map toLower]
 
     -- Create a permutation from a list of modifiers.
     --
@@ -1474,3 +1480,29 @@ modifyWindowBorder i = ModifyWindowBorder $ \(Border a b c d) ->
   where
     clip i | i < 0 = 0
     clip i = i
+
+screenDiscovery :: X ()
+screenDiscovery = do
+  ss <- gets windowset
+  forM_ (zip (True : repeat False) (screens ss)) $
+    \( foc,
+       W.Screen
+         { W.workspace = (W.Workspace tag _ _),
+           W.screenDetail = SD rect
+         }
+       ) ->
+        do
+          liftIO (launchDzen foc tag rect)
+  where
+    launchDzen foc tag (Rectangle x y w h) = do
+      pipe <-
+        spawnPipe
+          ( printf
+              "dzen2 -fn \"Monofur Nerd Font:size=150\" -p 1 -x %d -y %d -w 350 -h 350 -bg '%s' -fg '#000000'"
+              (x + (fromIntegral w `div` 2) - 175)
+              (y + (fromIntegral h `div` 2) - 175)
+              (if foc then "#ff8888" else "#8888ff")
+          )
+      hPutStrLn pipe tag
+      hFlush pipe
+      hClose pipe