aboutsummaryrefslogtreecommitdiff
path: root/src/Rahm/Desktop
diff options
context:
space:
mode:
Diffstat (limited to 'src/Rahm/Desktop')
-rw-r--r--src/Rahm/Desktop/Keys.hs19
-rw-r--r--src/Rahm/Desktop/Keys/Wml.hs72
2 files changed, 66 insertions, 25 deletions
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 9ae9c30..a453df1 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -187,13 +187,6 @@ keymap = runKeys $ do
doc "Print this documentation." $
logs (documentation (keymap config))
- bind xK_F8 $
-
- justMod $
- doc "Experimental" $ do
- (logs . printf "WS: %s" . show . fmap workspaceName) =<< workspaceForString ",^"
- (logs . printf "Wins: %s" . show) =<< locationSetForString "&s@,^"
-
bind xK_F10 $ do
justMod playPauseDoc
@@ -299,6 +292,18 @@ keymap = runKeys $ do
moveLocationToWorkspaceFn ws loc
gotoWorkspaceFn ws
+ bind xK_d $
+ justMod $
+ doc "Record (define) macros." $
+ subkeys $ do
+ bind xK_w $ noMod $
+ doc "Record a windowset macro" $
+ runMaybeT_ readWindowsetMacro
+
+ bind xK_t $ noMod $
+ doc "Record a workspace macro" $
+ runMaybeT_ readWorkspaceMacro
+
bind xK_h $ do
justMod $
doc "Focus on the next window down in the stack" $
diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index 0dfb852..7659a7d 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -14,6 +14,7 @@
-- \%@s // All windows except those on workspace 's'
module Rahm.Desktop.Keys.Wml where
+import qualified XMonad.Util.ExtensibleState as XS
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.State as S
import Control.Monad.Trans.Class
@@ -23,6 +24,7 @@ import Data.Ord (Down(..))
import Data.Typeable (cast)
import qualified Data.Map as Map
+import Data.Map (Map)
import Data.Char (isAlphaNum, isAlpha, isDigit, ord)
import Data.Maybe (fromMaybe, catMaybes)
import XMonad.Actions.CopyWindow as CopyWindow
@@ -43,6 +45,17 @@ import Text.Printf
import XMonad
+type KeyString = [(KeyMask, KeySym, String)]
+
+data Macros = Macros {
+ workspaceMacros :: Map (KeyMask, KeySym) KeyString
+, windowsetMacros :: Map (KeyMask, KeySym) KeyString
+} deriving (Read, Show)
+
+instance ExtensionClass Macros where
+ initialValue = Macros Map.empty Map.empty
+ extensionType = PersistentExtension
+
data Workspace =
forall a. (Typeable a) => Workspace {
moveLocationToWorkspaceFn :: Location -> X ()
@@ -51,6 +64,27 @@ data Workspace =
, extraWorkspaceData :: a
}
+readWorkspaceMacro :: MaybeT X ()
+readWorkspaceMacro =
+ mapNextStringWithKeysym $ \mask sym _ -> do
+ macro <- readMacroString
+ lift $ XS.modify $ \m -> m {
+ workspaceMacros = Map.insert (mask, sym) macro (workspaceMacros m) }
+
+readWindowsetMacro :: MaybeT X ()
+readWindowsetMacro =
+ mapNextStringWithKeysym $ \mask sym _ -> do
+ macro <- readMacroString
+ lift $ XS.modify $ \m -> m {
+ windowsetMacros = Map.insert (mask, sym) macro (windowsetMacros m) }
+
+readMacroString :: MaybeT X KeyString
+readMacroString = do
+ mapNextStringWithKeysym $ \m k s -> case (m, k, s) of
+ _ | k == xK_Return -> return []
+ _ | k == xK_Escape -> MaybeT $ return Nothing
+ r -> ([r]++) <$> readMacroString
+
justWorkspace :: String -> Workspace
justWorkspace s =
Workspace {
@@ -133,7 +167,7 @@ instance KeyFeeder X where
fromX = id
readNextKey = mapNextStringWithKeysym
-newtype FeedKeys a = FeedKeys { unFeedKeys :: StateT String X a }
+newtype FeedKeys a = FeedKeys { unFeedKeys :: StateT KeyString X a }
deriving (Monad, Functor, Applicative)
instance KeyFeeder FeedKeys where
@@ -142,32 +176,32 @@ instance KeyFeeder FeedKeys where
readNextKey fn = do
ls <- lift $ FeedKeys S.get
case ls of
- (h:t) -> do
+ ((mask, sym, str):t) -> do
lift $ FeedKeys $ S.put t
- fn 0 0 [h]
+ fn mask sym str
_ -> MaybeT (return Nothing)
-feedKeys :: String -> MaybeT FeedKeys a -> X (Maybe a)
+feedKeys :: KeyString -> MaybeT FeedKeys a -> X (Maybe a)
feedKeys s mf = flip evalStateT s . unFeedKeys $ runMaybeT mf
-feedKeysT :: String -> MaybeT FeedKeys a -> MaybeT X a
+feedKeysT :: KeyString -> MaybeT FeedKeys a -> MaybeT X a
feedKeysT s mf = MaybeT $ feedKeys s mf
-- Allows a reference to a workspace in terms of its description in the window
-- management language.
-workspaceForStringT :: String -> MaybeT X Workspace
-workspaceForStringT str = feedKeysT str readNextWorkspace
+workspaceForKeysT :: KeyString -> MaybeT X Workspace
+workspaceForKeysT str = feedKeysT str readNextWorkspace
-- Like the above, but unwrap the MaybeT
-workspaceForString :: String -> X (Maybe Workspace)
-workspaceForString = runMaybeT . workspaceForStringT
+workspaceForKeys :: KeyString -> X (Maybe Workspace)
+workspaceForKeys = runMaybeT . workspaceForKeysT
-- Like the above, but unwrap the MaybeT
-locationSetForStringT :: String -> MaybeT X [Location]
-locationSetForStringT s = feedKeysT s readNextLocationSet
+locationSetForKeysT :: KeyString -> MaybeT X [Location]
+locationSetForKeysT s = feedKeysT s readNextLocationSet
-locationSetForString :: String -> X [Location]
-locationSetForString s = fromMaybe [] <$> runMaybeT (locationSetForStringT s)
+locationSetForKeys :: KeyString -> X [Location]
+locationSetForKeys s = fromMaybe [] <$> runMaybeT (locationSetForKeysT s)
-- Returns the next workspaces associated with the next set of keystrokes.
readNextWorkspace :: (KeyFeeder m) => MaybeT m Workspace
@@ -187,8 +221,6 @@ readNextWorkspace =
(_, _, ")") -> mt $
justWorkspace <$>
(adjacentWorkspace next =<< getCurrentWorkspace)
- (_, _, "}") -> mt $ justWorkspace <$> adjacentScreen next
- (_, _, "{") -> mt $ justWorkspace <$> adjacentScreen prev
(_, _, "^") -> mapMaybeT fromX $ MaybeT $
withWindowSet $ \ws -> return $
(fmap (justWorkspace . W.tag . W.workspace . snd) . head)
@@ -233,7 +265,9 @@ readNextWorkspace =
justWorkspace . accompaningWorkspace <$> getCurrentWorkspace
(_, _, "_") -> return blackHoleWorkspace
(_, _, "-") -> return alternateWorkspace
- _ -> MaybeT (return Nothing)
+ (mask, keysym, _) -> do
+ macro <- (MaybeT . fromX) (Map.lookup (mask, keysym) . workspaceMacros <$> XS.get)
+ fromMaybeTX $ workspaceForKeysT macro
where
mt :: (KeyFeeder m) => X a -> MaybeT m a
mt = lift . fromX
@@ -293,8 +327,10 @@ readNextLocationSet =
l1 <- readNextLocationSet
l2 <- readNextLocationSet
return $ filter (`elem` l2) l1
-
- _ -> MaybeT (return Nothing)
+ (mask, keysym, _) -> do
+ macro <- (MaybeT . fromX) (Map.lookup (mask, keysym) . windowsetMacros <$> XS.get)
+ lift $ fromX $ logs $ "Executing Macro: " ++ show macro
+ fromMaybeTX $ locationSetForKeysT macro
where
mt :: (KeyFeeder m) => X a -> MaybeT m a
mt = lift . fromX
generated by cgit (git 2.34.1) at 2026-02-22 21:03:25 +0000