Add macro support to WML.

Macros may be defined by using <M-d>

<M-d>w begins defining a windowset macro
<M-d>t begins defining a workspace macro

The next character typed is the key chord to save the macro to. The next
sequence of keys read up until the Return key is the macro value. This
macro may then be used as WML objects.

Macros are pretty primitive right now. I need to think about if it would
be worthwhile to make these macros either take arguments or add some
kind of state to WML a la sed to take a step to make the language Turing
complete, and if such a development would actually be desirable. If
anything it would be an academic exercise.

3 files changed, 89 insertions, 29 deletions

diff --git a/README.md b/README.md
index 06a8631..0d6bfb9 100644
--- a/README.md
+++ b/README.md
@@ -155,10 +155,6 @@ workspaces.
    * `.`: The current workspace
    * `[`: The next non-visible workspace to the right of this one.
    * `]`: The next non-visible workspace to the left of this one.
-   * `{`: The workspace on the screen to the left of the current workspace
-     (equivalent to `;.`)
-   * `}`: The workspace on the screen to the right of the current workspace.
-     (equivalent to `,.`)
    * `(`: The next workspace to the right
    * `)`: The next workspace to the left
    * `^`: The workspace on the rightmost screen.
@@ -274,3 +270,26 @@ exactly what one is wanting to do.
     workspace x to worksapce x.
 
   * `,;x` is just references x for any x because the `;` undos the `,`
+
+#### Macros
+
+Remembering and using some of these key sequences can be troublesome, especially
+if that key sequences is used often. For this reason, RDE has the ability to
+record macros to reference these objects.
+
+To record a macro, type `<M-d>` then if
+  * You want to record a windowset macro, type `w`
+    1. Type the key chord to record the macro to (Ctrl+characters work well)
+    1. Type the key sequence to record and hit `<Return>`
+  * You want to record a workspace macro, type `t`
+    1. Type the key chord to record the macro to (Ctrl+characters work well)
+    1. Type the key sequence to record and hit `<Return>`
+
+Example:
+
+If one types `<M-d>w+\@..<Return>` this will record the macro `\@..` (Which
+references all windows on the current workspace except the current window) as
+`+`, so now one can type `<M-s>+_` to kill all the windows on the current
+workspace except the current window.
+
+NOTE: Recursive macros are not prohibited. Be careful!
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