Add basic language for moving windows around

1 files changed, 32 insertions, 56 deletions

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 1369a17..23927ef 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -1,5 +1,6 @@
 module Rahm.Desktop.Keys (applyKeys) where
 
+import Control.Monad.Trans.Maybe
 import Control.Applicative
 import Control.Monad
 import Control.Monad.Fix (fix)
@@ -11,7 +12,7 @@ import Data.Char
 import Data.List hiding ((!!))
 import Data.List.Safe ((!!))
 import Data.Map (Map)
-import Data.Maybe (isJust, fromMaybe)
+import Data.Maybe (isJust, fromMaybe, mapMaybe)
 import Data.Monoid (Endo(..))
 import Debug.Trace
 import Graphics.X11.ExtraTypes.XF86;
@@ -51,6 +52,7 @@ import Rahm.Desktop.Layout.Rotate (rotateLayout)
 import Rahm.Desktop.Common
 import Rahm.Desktop.Logger
 import Rahm.Desktop.Marking
+import Rahm.Desktop.Lang
 import Rahm.Desktop.MouseMotion
 import Rahm.Desktop.PassMenu
 import Rahm.Desktop.PromptConfig
@@ -141,13 +143,11 @@ keymap = runKeys $ do
   bind xK_apostrophe $ do
     justMod $
       doc "Jumps between marks." $
-      mapNextString $ const (mapM_ focusLocation <=< markToLocation)
-
-    shiftMod $
-      doc "Move the marked window to the current workspace." $
-      mapNextString $ \_ str -> do
-        mapM_ (\loc -> moveLocationToWorkspace loc <$> getCurrentWorkspace)
-          =<< markToLocation str
+      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
@@ -279,50 +279,23 @@ 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" $
-      mapNextStringWithKeysym $ \_ keysym str ->
-        case ((keysym, str), selectWorkspace str) of
-          (_, Just w) -> gotoWorkspace =<< w
-          -- Test binding. Tests that I can still submap keysyms alone (keys
-          -- where XLookupString won't return anything helpful.)
-          ((f, _), _) | f == xK_F1 ->
-            (safeSpawn "gxmessage" [
-              "-fn", "Source Code Pro",
-              documentation (keymap config)] :: X ())
-          _ -> return ()
+      runMaybeT_ $ (lift . gotoWorkspaceFn) =<< readNextWorkspace
 
     shiftMod $
       doc "Move the currently focused window to another workspace" $
-      mapNextStringWithKeysym $ \_ keysym str ->
-        case ((keysym, str), selectWorkspace str) of
-          (_, Just w) -> shiftToWorkspace =<< w
-          ((_, "_"), _) -> CopyWindow.kill1
-          _ -> return ()
+      runMaybeT_ $ do
+        ws <- readNextWorkspace
+        loc <- lift getCurrentLocation
+        lift $ moveLocationToWorkspaceFn ws loc
 
     controlMod $
       doc "Move the current focused window to another workspace and view that workspace" $
-      mapNextStringWithKeysym $ \_ keysym str ->
-        case ((keysym, str), selectWorkspace str) of
-          (_, Just w) -> do
-            ws <- w
-            shiftToWorkspace ws
-            gotoWorkspace ws
-          _ -> return ()
-
-    altMod $
-      doc "Copy a window to the given workspace" $
-      mapNextStringWithKeysym $ \_ keysym str ->
-        case ((keysym, str), selectWorkspace str) of
-          (_, Just ws) -> windows . CopyWindow.copy =<< ws
-          _ -> return ()
-
-    shiftAltMod $
-      doc "Swap this workspace with another workspace (rename)." $
-      mapNextStringWithKeysym $ \_ keysym str ->
-        case ((keysym, str), selectWorkspace str) of
-          (_, Just ws) -> swapWorkspace =<< ws
-          ((_, "_"), _) ->
-            mapM_ (\w -> focus w >> CopyWindow.kill1) =<< windowsInCurrentWorkspace
-          _ -> return ()
+      runMaybeT_ $ do
+        ws <- readNextWorkspace
+        loc <- lift getCurrentLocation
+        lift $ do
+          moveLocationToWorkspaceFn ws loc
+          gotoWorkspaceFn ws
 
   bind xK_h $ do
     justMod $
@@ -382,7 +355,7 @@ keymap = runKeys $ do
   bind xK_m $ do
     justMod $
       doc "Mark the current window with the next typed character." $
-      mapNextString $ \_ str ->
+      runMaybeT_ $ mapNextString $ \_ str -> lift $
         case str of
           [ch] | isAlpha ch -> markCurrentWindow str
           _ -> return ()
@@ -417,16 +390,19 @@ keymap = runKeys $ do
       sendMessage rotateLayout
 
   bind xK_s $ do
-    justMod $
-      mapNextString $ \_ mark -> do
-        loc' <- markToLocation mark
-        case loc' of
-          Nothing -> return ()
-          Just loc -> do
-            mapM_ setAlternateWindow (locationWindow loc)
-            mapNextString $ \_ ws -> do
-              mapM_ (moveLocationToWorkspace loc=<<) (selectWorkspace ws)
+    justMod $ runMaybeT_ $ do
+      locations <- readNextLocationSet 
+
+      workspace <- readNextWorkspace
+      mapM_ (lift . moveLocationToWorkspaceFn workspace) locations
 
+      lift $ setAlternateWindows (mapMaybe locationWindow locations)
+      forM_ locations $ \loc ->
+        case locationWindow loc of
+          Nothing -> return ()
+          Just win -> do
+            lift $ logs $ printf "setAlternate %s %s" (show win) (show $ locationWorkspace loc)
+            lift $ setAlternateWorkspace win (locationWorkspace loc)
 
     altMod $ spawnX "sudo -A systemctl suspend && xsecurelock"