aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Rahm/Desktop/Keys.hs114
-rw-r--r--src/Rahm/Desktop/Keys/Wml.hs8
-rw-r--r--src/Rahm/Desktop/XMobarLog.hs9
-rw-r--r--src/Rahm/Desktop/XMobarLog/PendingBuffer.hs53
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
generated by cgit (git 2.34.1) at 2026-02-22 17:57:08 +0000