Better implementation of the pending buffer. Still need to iron out some bugs.

5 files changed, 108 insertions, 45 deletions

diff --git a/src/Main.hs b/src/Main.hs
index 1f059aa..6a07f29 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -27,6 +27,7 @@ import XMonad.Hooks.ManageHelpers (doFullFloat, isFullscreen)
 import XMonad.Layout.Fullscreen (fullscreenEventHook)
 
 main = do
+  logHook <- xMobarLogHook
   putStrLn "Welcome To RDE!"
 
   -- Execute some commands.
@@ -37,7 +38,6 @@ main = do
   setEnv "ROFI" menuCommandString
 
   xmobar <- spawnXMobar
-  logHook <- xMobarLogHook
 
   (=<<) X.xmonad $
     applyKeys $
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index e55c636..d8b7f20 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, isNothing)
+import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
 import Data.Monoid (Endo (..))
 import Data.Proxy
 import Debug.Trace
@@ -139,11 +139,28 @@ keyBindingToKeymap bindings config = Map.mapWithKey bindingToX (bindings config)
       case b of
         Documented _ (Action x) -> x
         Documented _ (Submap mapping) ->
-          submap (Map.mapWithKey bindingToX mapping)
+          withPendingBuffer $ do
+            -- This is a submap, add it to the pending buffer.
+            --
+            -- This could potentially use the current event in the XState and
+            -- lookupString to potentially recover the real string typed, but
+            -- for now, this will do.
+            addStringToPendingBuffer (keysymToString $ snd key)
+            submap (Map.mapWithKey bindingToX mapping)
         Documented _ (Repeat mapping) -> do
-          mapM_ (bindingToX key) (Map.lookup key mapping)
-          fix $ \recur ->
-            submap (Map.mapWithKey (\k b -> bindingToX k b >> recur) mapping)
+          withPendingBuffer $ do
+            addStringToPendingBuffer (keysymToString $ snd key)
+            mapM_ (bindingToX key) (Map.lookup key mapping)
+            fix $ \recur -> do
+              submap
+                ( Map.mapWithKey
+                    ( \k b -> do
+                        withPendingBuffer $ do
+                          addStringToPendingBuffer (keysymToString $ snd k)
+                          bindingToX k b >> recur
+                    )
+                    mapping
+                )
 
 keymap :: XConfig l -> KeyBindings
 keymap = runKeys $ do
@@ -156,7 +173,7 @@ keymap = runKeys $ do
     justMod $
       doc "Jumps between marks." $
         withPendingBuffer $ do
-          setPendingBuffer "Jump To "
+          setPendingBuffer "w "
           runMaybeT_ $ do
             l <- readNextLocationSet
             case l of
@@ -279,7 +296,7 @@ keymap = runKeys $ do
     justMod $
       doc
         "Goto/Send/Etc To a workspace\n\n\t\
-        \Workspaces are alphanumeric characters. So if the next key typed is an\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\
         \\tThe following special characters can also reference workspaces:\n\t\t\
         \]: The next workspace, skipping those already visible.\n\t\t\
@@ -297,13 +314,13 @@ keymap = runKeys $ do
         \Other keybindings starting with H-g\n\t\t\
         \F1: display this help.\n\n\t"
         $ withPendingBuffer $ do
-          setPendingBuffer "Goto "
+          setPendingBuffer "g "
           runMaybeT_ $ (lift . gotoWorkspaceFn) =<< readNextWorkspace
 
     controlMod $
       doc "Restore the desktop marked with the next typed character." $
         withPendingBuffer $ do
-          setPendingBuffer "Restore "
+          setPendingBuffer "C-g "
           runMaybeT_ $ do
             mapNextString $ \_ str -> lift $
               case str of
@@ -319,7 +336,7 @@ keymap = runKeys $ do
     shiftMod $
       doc "Restore a theater state" $
         withPendingBuffer $ do
-          setPendingBuffer "Goto Theater"
+          setPendingBuffer "G "
           runMaybeT_ $ do
             mapNextString $ \_ str -> lift $
               case str of
@@ -368,12 +385,16 @@ keymap = runKeys $ do
           bind xK_w $
             noMod $
               doc "Record a windowset macro" $
-                runMaybeT_ readWindowsetMacro
+                withPendingBuffer $ do
+                  setPendingBuffer "Win Macro "
+                  runMaybeT_ readWindowsetMacro
 
           bind xK_t $
             noMod $
               doc "Record a workspace macro" $
-                runMaybeT_ readWorkspaceMacro
+                withPendingBuffer $ do
+                  setPendingBuffer "Wksp Macro "
+                  runMaybeT_ readWorkspaceMacro
 
   bind xK_h $ do
     justMod $
@@ -436,7 +457,7 @@ keymap = runKeys $ do
     justMod $
       doc "Mark the current window with the next typed character." $ do
         withPendingBuffer $ do
-          addStringToPendingBuffer "Mark "
+          addStringToPendingBuffer "m "
           locs <- fromMaybe [] <$> runMaybeT readNextLocationSet
           let wins = mapMaybe locationWindow locs
           unless (null wins) $ do
@@ -449,19 +470,23 @@ keymap = runKeys $ do
 
     shiftMod $
       doc "Mark the current desktop with the next typed character." $
-        runMaybeT_ $ do
-          mapNextString $ \_ str -> lift $
-            case str of
-              [ch] | isAlpha ch -> saveCurrentDesktop str
-              _ -> return ()
+        withPendingBuffer $ do
+          addStringToPendingBuffer "M "
+          runMaybeT_ $ do
+            mapNextString $ \_ str -> lift $
+              case str of
+                [ch] | isAlpha ch -> saveCurrentDesktop str
+                _ -> return ()
 
     controlMod $
       doc "Mark the current theater with the next typed character." $
-        runMaybeT_ $ do
-          mapNextString $ \_ str -> lift $
-            case str of
-              [ch] | isAlpha ch -> saveCurrentTheater (Just str)
-              _ -> return ()
+        withPendingBuffer $ do
+          addStringToPendingBuffer "C-M "
+          runMaybeT_ $ do
+            mapNextString $ \_ str -> lift $
+              case str of
+                [ch] | isAlpha ch -> saveCurrentTheater (Just str)
+                _ -> return ()
 
   bind xK_plus $ do
     justMod $
@@ -500,7 +525,7 @@ keymap = runKeys $ do
               else "Shift a windowset to a workspace"
           )
           $ withPendingBuffer $ do
-            setPendingBuffer $ if doSwap then "Swap " else "Shift "
+            setPendingBuffer $ if doSwap then "S " else "s "
             maybeLocs <- runMaybeT readNextLocationSet
 
             forM_ maybeLocs $ \locations -> do
@@ -653,6 +678,12 @@ keymap = runKeys $ do
                 "Kill all other copies of a window."
                 CopyWindow.killAllOtherCopies
 
+          bind xK_q $
+            justMod $ do
+              subkeys $ do
+                bind xK_q $
+                  justMod $ spawnX "echo hi"
+
           bind xK_e $ do
             (justMod -|- noMod) $
               doc "Select an emoji" $
diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index 10f2b5f..623e59a 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -14,7 +14,7 @@
 -- \%@s       // All windows except those on workspace 's'
 module Rahm.Desktop.Keys.Wml where
 
-import Control.Monad (forM_, join, unless)
+import Control.Monad (forM_, join, unless, when)
 import Control.Monad.Trans.Class
 import Control.Monad.Trans.Maybe
 import Control.Monad.Trans.State as S
@@ -67,7 +67,11 @@ data Workspace = forall a.
 
 readWorkspaceMacro :: MaybeT X ()
 readWorkspaceMacro =
-  mapNextStringWithKeysym $ \mask sym _ -> do
+  mapNextStringWithKeysym $ \mask sym s -> do
+    when (sym == xK_Escape) $
+      fail ""
+
+    lift $ setPendingBuffer $ printf "Rec %s " s
     macro <- readMacroString
     lift $
       XS.modify $ \m ->
@@ -77,7 +81,11 @@ readWorkspaceMacro =
 
 readWindowsetMacro :: MaybeT X ()
 readWindowsetMacro =
-  mapNextStringWithKeysym $ \mask sym _ -> do
+  mapNextStringWithKeysym $ \mask sym s -> do
+    when (sym == xK_Escape) $
+      fail ""
+
+    lift $ setPendingBuffer $ printf "Rec %s " s
     macro <- readMacroString
     lift $
       XS.modify $ \m ->
@@ -90,7 +98,9 @@ readMacroString = do
   mapNextStringWithKeysym $ \m k s -> case (m, k, s) of
     _ | k == xK_Return -> return []
     _ | k == xK_Escape -> MaybeT $ return Nothing
-    r -> ([r] ++) <$> readMacroString
+    r -> do
+      lift $ addStringToPendingBuffer s
+      ([r] ++) <$> readMacroString
 
 justWorkspace :: String -> Workspace
 justWorkspace s =
diff --git a/src/Rahm/Desktop/XMobarLog.hs b/src/Rahm/Desktop/XMobarLog.hs
index 7ac8315..62cf7c9 100644
--- a/src/Rahm/Desktop/XMobarLog.hs
+++ b/src/Rahm/Desktop/XMobarLog.hs
@@ -3,7 +3,8 @@ module Rahm.Desktop.XMobarLog (XMobarLog, spawnXMobar, xMobarLogHook) where
 import Control.Arrow (second)
 import Control.Monad (forM_, unless)
 import Control.Monad.Writer (execWriter, tell)
-import Data.Char (isAsciiLower, isAsciiUpper, isDigit)
+import Data.Char (isAsciiLower, isAsciiUpper, isDigit, isSpace)
+import Data.IORef
 import Data.List (sortBy)
 import Data.Maybe (isJust, mapMaybe)
 import Data.Ord (comparing)
@@ -19,7 +20,7 @@ import Text.Printf
 import XMonad (X)
 import qualified XMonad as X
 import XMonad.Util.NamedWindows (getName)
-import XMonad.Util.Run (spawnPipe)
+import XMonad.Util.Run (runProcessWithInput, spawnPipe)
 
 newtype XMobarLog = XMobarLog Handle
 
@@ -43,12 +44,12 @@ spawnXMobar = do
 -- XMonad Log Hook meant to be used with the XMonad config logHook.
 xMobarLogHook :: IO (XMobarLog -> X ())
 xMobarLogHook = do
-  -- uname <- readProcess "/usr/bin/uname" ["-r"] ""
-  let uname = "44444"
+  unameRef <- newIORef Nothing
 
-  return $ \(XMobarLog xmproc) -> do
-    let pendingBufferFiller = "               "
+  -- (_, uname, _) <- readProcessWithExitCode "/usr/bin/uname" ["-r"] ""
+  -- putStrLn $ "Uname " ++ uname
 
+  return $ \(XMobarLog xmproc) -> do
     (_, _, layoutXpm) <- drawLayout
 
     loglevel <- getLogLevel
@@ -57,19 +58,29 @@ xMobarLogHook = do
     winset <- X.gets X.windowset
     title <- maybe (pure "") (fmap show . getName) . S.peek $ winset
     pendingBuffer'' <- getPendingBuffer
-    let pendingBuffer' =
+
+    uname <- getUname unameRef
+
+    let pendingBufferSize = max 10 $ length uname
+
+    let (pendingBufferColor, pendingBuffer') =
           if null pendingBuffer''
-            then uname
-            else pendingBuffer''
-    let pendingBuffer = take 10 $ reverse (take 10 (reverse pendingBuffer')) ++ repeat ' '
+            then ("#a0a0a0", uname)
+            else ("#f0a0a0,#202020", pendingBuffer'')
+    let pendingBuffer =
+          take pendingBufferSize $
+            reverse
+              ( take pendingBufferSize (reverse pendingBuffer')
+              )
+              ++ repeat ' '
 
     let wss = getPopulatedWorkspaces winset
 
     let log = trunc 80 $
           execWriter $ do
-            tell "  <fc=#a0a0a0><fn=3>"
+            tell $ printf "<fc=%s><fn=3> " pendingBufferColor
             tell pendingBuffer
-            tell "</fn></fc>  "
+            tell "</fn></fc>"
 
             tell " "
             tell (toChangeLayoutAction layoutXpm)
@@ -132,6 +143,18 @@ xMobarLogHook = do
     logLevelToXMobar Fatal = "<fn=3><fc=#888888>[Fatal]</fc></fn>   "
     logLevelToXMobar _ = ""
 
+    getUname ref = X.io $ do
+      s <- readIORef ref
+      case s of
+        Nothing -> do
+          uname' <- runProcessWithInput "uname" ["-r"] ""
+
+          let uname = dropWhile isSpace (reverse $ dropWhile isSpace $ reverse uname')
+
+          writeIORef ref $ Just uname
+          return uname
+        Just uname -> return uname
+
 -- Truncate an XMobar string to the provided number of _visible_ characters.
 -- This is to keep long window titles from overrunning the whole bar.
 trunc :: Int -> String -> String
diff --git a/src/Rahm/Desktop/XMobarLog/PendingBuffer.hs b/src/Rahm/Desktop/XMobarLog/PendingBuffer.hs
index 0c00649..1ae298b 100644
--- a/src/Rahm/Desktop/XMobarLog/PendingBuffer.hs
+++ b/src/Rahm/Desktop/XMobarLog/PendingBuffer.hs
@@ -46,8 +46,7 @@ clearPendingBuffer = do
 getPendingBuffer :: X [Char]
 getPendingBuffer = unPendingBuffer <$> XS.get
 
-withPendingBuffer :: X () -> X ()
+withPendingBuffer :: X a -> X a
 withPendingBuffer fn = do
-  clearPendingBuffer
-  fn
-  clearPendingBuffer
+  saved <- getPendingBuffer
+  fn <* setPendingBuffer saved