Rudimentary pending buffer shown in Xmobar.

4 files changed, 131 insertions, 53 deletions

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 0ab868f..e55c636 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -13,7 +13,7 @@ import Data.List hiding ((!!))
 import Data.List.Safe ((!!))
 import Data.Map (Map)
 import qualified Data.Map as Map
-import Data.Maybe (fromMaybe, isJust, mapMaybe)
+import Data.Maybe (fromMaybe, isJust, mapMaybe, isNothing)
 import Data.Monoid (Endo (..))
 import Data.Proxy
 import Debug.Trace
@@ -46,6 +46,7 @@ import Rahm.Desktop.Swallow
 import Rahm.Desktop.SwapMaster (swapMaster)
 import Rahm.Desktop.Theater
 import Rahm.Desktop.Workspaces
+import Rahm.Desktop.XMobarLog.PendingBuffer
 import System.IO
 import System.Process
 import Text.Printf
@@ -154,11 +155,13 @@ keymap = runKeys $ do
   forM_ [xK_apostrophe, xK_w] $ \k -> bind k $ do
     justMod $
       doc "Jumps between marks." $
-        runMaybeT_ $ do
-          l <- readNextLocationSet
-          case l of
-            (h : _) -> lift (focusLocation h)
-            _ -> return ()
+        withPendingBuffer $ do
+          setPendingBuffer "Jump To "
+          runMaybeT_ $ do
+            l <- readNextLocationSet
+            case l of
+              (h : _) -> lift (focusLocation h)
+              _ -> return ()
 
   bind xK_BackSpace $ do
     -- The only raw keybinding. Meant to get a terminal to unbrick XMonad if
@@ -293,15 +296,19 @@ 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"
-        $ runMaybeT_ $ (lift . gotoWorkspaceFn) =<< readNextWorkspace
+        $ withPendingBuffer $ do
+          setPendingBuffer "Goto "
+          runMaybeT_ $ (lift . gotoWorkspaceFn) =<< readNextWorkspace
 
     controlMod $
       doc "Restore the desktop marked with the next typed character." $
-        runMaybeT_ $ do
-          mapNextString $ \_ str -> lift $
-            case str of
-              [ch] | isAlpha ch -> restoreDesktop [ch]
-              _ -> return ()
+        withPendingBuffer $ do
+          setPendingBuffer "Restore "
+          runMaybeT_ $ do
+            mapNextString $ \_ str -> lift $
+              case str of
+                [ch] | isAlpha ch -> restoreDesktop [ch]
+                _ -> return ()
 
     -- shiftMod $
     --   doc "Swap a workspace with another workspace." $
@@ -311,12 +318,14 @@ keymap = runKeys $ do
 
     shiftMod $
       doc "Restore a theater state" $
-        runMaybeT_ $ do
-          mapNextString $ \_ str -> lift $
-            case str of
-              [ch] | isAlpha ch -> restoreTheater (Just [ch])
-              [' '] -> restoreTheater Nothing
-              _ -> return ()
+        withPendingBuffer $ do
+          setPendingBuffer "Goto Theater"
+          runMaybeT_ $ do
+            mapNextString $ \_ str -> lift $
+              case str of
+                [ch] | isAlpha ch -> restoreTheater (Just [ch])
+                [' '] -> restoreTheater Nothing
+                _ -> return ()
 
   bind xK_n $ do
     justMod $
@@ -426,14 +435,17 @@ keymap = runKeys $ do
   bind xK_m $ do
     justMod $
       doc "Mark the current window with the next typed character." $ do
-        locs <- fromMaybe [] <$> runMaybeT readNextLocationSet
-        let wins = mapMaybe locationWindow locs
-        withBorderColor "#00ffff" wins $ do
-          runMaybeT_ $ do
-            mapNextString $ \_ str -> lift $
-              case str of
-                [ch] | isAlpha ch -> markAllLocations str locs
-                _ -> return ()
+        withPendingBuffer $ do
+          addStringToPendingBuffer "Mark "
+          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 ()
 
     shiftMod $
       doc "Mark the current desktop with the next typed character." $
@@ -487,31 +499,33 @@ keymap = runKeys $ do
               then "Swap a windowset with another windowset."
               else "Shift a windowset to a workspace"
           )
-          $ do
-            locations <- fromMaybe [] <$> runMaybeT readNextLocationSet
-            let locationWindows = mapMaybe locationWindow locations
-
-            withBorderColor "#00ffff" locationWindows $ do
-              runMaybeT_ $ do
-                if doSwap
-                  then do
-                    otherWindows <-
+          $ withPendingBuffer $ do
+            setPendingBuffer $ if doSwap then "Swap " else "Shift "
+            maybeLocs <- runMaybeT readNextLocationSet
+
+            forM_ maybeLocs $ \locations -> do
+              let locationWindows = mapMaybe locationWindow locations
+              withBorderColor "#00ffff" locationWindows $ do
+                runMaybeT_ $ do
+                  if doSwap
+                    then do
+                      otherWindows <-
+                        lift $
+                          mapMaybe locationWindow . fromMaybe []
+                            <$> runMaybeT readNextLocationSet
                       lift $
-                        mapMaybe locationWindow . fromMaybe []
-                          <$> runMaybeT readNextLocationSet
-                    lift $
-                      windows $
-                        W.swapWindows (zip locationWindows otherWindows)
-                  else do
-                    workspace <- readNextWorkspace
-                    mapM_ (lift . moveLocationToWorkspaceFn workspace) locations
-
-                lift $ setAlternateWindows locationWindows
-                forM_ locations $ \loc ->
-                  case locationWindow loc of
-                    Nothing -> return ()
-                    Just win -> do
-                      lift $ setAlternateWorkspace win (locationWorkspace loc)
+                        windows $
+                          W.swapWindows (zip locationWindows otherWindows)
+                    else do
+                      workspace <- readNextWorkspace
+                      mapM_ (lift . moveLocationToWorkspaceFn workspace) locations
+
+                  lift $ setAlternateWindows locationWindows
+                  forM_ locations $ \loc ->
+                    case locationWindow loc of
+                      Nothing -> return ()
+                      Just win -> do
+                        lift $ setAlternateWorkspace win (locationWorkspace loc)
 
     altMod $ spawnX "sudo -A systemctl suspend && xsecurelock"
 
diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index 1c8d073..10f2b5f 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -34,6 +34,7 @@ import Rahm.Desktop.Marking
 import qualified Rahm.Desktop.StackSet as W
 import Rahm.Desktop.Submap
 import Rahm.Desktop.Workspaces
+import Rahm.Desktop.XMobarLog.PendingBuffer
 import System.Exit (ExitCode (..), exitWith)
 import Text.Printf
 import XMonad
@@ -182,7 +183,10 @@ class (Monad m) => KeyFeeder m where
 
 instance KeyFeeder X where
   fromX = id
-  readNextKey = mapNextStringWithKeysym
+  readNextKey fn = mapNextStringWithKeysym $
+    \mask sym str -> do
+      lift $ fromX $ addStringToPendingBuffer str
+      fn mask sym str
 
 newtype FeedKeys a = FeedKeys {unFeedKeys :: StateT KeyString X a}
   deriving (Monad, Functor, Applicative)
@@ -229,7 +233,7 @@ readNextWorkspaceName = joinMaybe $ workspaceName <$> readNextWorkspace
 -- Returns the next workspaces associated with the next set of keystrokes.
 readNextWorkspace :: (KeyFeeder m) => MaybeT m Workspace
 readNextWorkspace =
-  readNextKey $ \mask sym str ->
+  readNextKey $ \mask sym str -> do
     case (mask, sym, str) of
       (_, e, _) | e == xK_Escape -> MaybeT $ return Nothing
       (_, _, [ch]) | isAlphaNum ch || ch == '*' -> return $ justWorkspace [ch]
diff --git a/src/Rahm/Desktop/XMobarLog.hs b/src/Rahm/Desktop/XMobarLog.hs
index dbe4808..05f6f21 100644
--- a/src/Rahm/Desktop/XMobarLog.hs
+++ b/src/Rahm/Desktop/XMobarLog.hs
@@ -12,6 +12,7 @@ import Rahm.Desktop.Logger
 import qualified Rahm.Desktop.StackSet as S
 import Rahm.Desktop.Theater (getTheaters)
 import Rahm.Desktop.Workspaces (WorkspaceState (..), getPopulatedWorkspaces)
+import Rahm.Desktop.XMobarLog.PendingBuffer (getPendingBuffer)
 import System.IO (Handle, hPutStrLn, hSetEncoding, utf8)
 import Text.Printf
 import XMonad (X)
@@ -44,6 +45,7 @@ xMobarLogHook (XMobarLog xmproc) = do
 
   winset <- X.gets X.windowset
   title <- maybe (pure "") (fmap show . getName) . S.peek $ winset
+  pendingBuffer <- getPendingBuffer
   let wss = getPopulatedWorkspaces winset
 
   let log = trunc 80 $
@@ -53,7 +55,7 @@ xMobarLogHook (XMobarLog xmproc) = do
           tell " "
           tell $ logLevelToXMobar loglevel
 
-          forM_ theaters $ \theater -> case theater of
+          forM_ theaters $ \case
             (Just n, _, True) -> do
               tell "<fn=1><fc=#ffffff>"
               tell $ toTheaterAction n
@@ -62,6 +64,7 @@ xMobarLogHook (XMobarLog xmproc) = do
               tell "<fn=2><fc=#888888>"
               tell $ toTheaterAction n
               tell " </fc></fn>"
+            _ -> return ()
 
           unless (null theaters) $ do
             tell "<fc=#888888>| </fc>"
@@ -74,6 +77,10 @@ xMobarLogHook (XMobarLog xmproc) = do
             tell $ toAction $ S.tag ws
             tell " </fc></fn>"
 
+          tell "  "
+          tell pendingBuffer
+          tell "  "
+
           tell "   <fc=#ff8888><fn=3>"
           tell title
           tell "</fn></fc>"
diff --git a/src/Rahm/Desktop/XMobarLog/PendingBuffer.hs b/src/Rahm/Desktop/XMobarLog/PendingBuffer.hs
new file mode 100644
index 0000000..0c00649
--- /dev/null
+++ b/src/Rahm/Desktop/XMobarLog/PendingBuffer.hs
@@ -0,0 +1,53 @@
+module Rahm.Desktop.XMobarLog.PendingBuffer where
+
+import Control.Monad (forM_, join)
+import Data.Default
+import Data.List (sortOn, (\\))
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Maybe
+import Data.Proxy
+import Data.Typeable
+import Rahm.Desktop.Logger
+import XMonad (X)
+import qualified XMonad as X
+import qualified XMonad.StackSet as W
+import qualified XMonad.Util.ExtensibleState as XS
+
+-- The pending buffer keeps track of pending characters. This is useful for when
+-- inputing Wml language constructs. Helps to keep the user from being too lost
+-- wheen it comes to keeping track of keystrokes.
+
+newtype PendingBuffer = PendingBuffer {unPendingBuffer :: [Char]}
+
+instance Default PendingBuffer where
+  def = PendingBuffer []
+
+instance X.ExtensionClass PendingBuffer where
+  initialValue = def
+
+addStringToPendingBuffer :: [Char] -> X ()
+addStringToPendingBuffer str = do
+  XS.modify $ \(PendingBuffer cs) ->
+    PendingBuffer (cs ++ str)
+
+  X.logHook . X.config =<< X.ask
+
+setPendingBuffer :: [Char] -> X ()
+setPendingBuffer cs = do
+  XS.put $ PendingBuffer cs
+  X.logHook . X.config =<< X.ask
+
+clearPendingBuffer :: X ()
+clearPendingBuffer = do
+  XS.put (def :: PendingBuffer)
+  X.logHook . X.config =<< X.ask
+
+getPendingBuffer :: X [Char]
+getPendingBuffer = unPendingBuffer <$> XS.get
+
+withPendingBuffer :: X () -> X ()
+withPendingBuffer fn = do
+  clearPendingBuffer
+  fn
+  clearPendingBuffer