Add more bindings to the "g" command.

3 files changed, 60 insertions, 22 deletions

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index c8387c6..748aae2 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -252,18 +252,43 @@ keymap = runKeys $ do
 
   bind xK_g $ do
     justMod $
-      doc ("Go to a workspace. The next typed character is the workspace " ++
-          "must be alpha-numeric.") $
-      mapNextString $ \_ str ->
-        case str of
-          [ch] | isAlphaNum ch -> gotoWorkspace ch
-          [' '] -> gotoAccompaningWorkspace
+      doc ("Goto a workspace\n\n\t\
+
+      \If the second character typed is alpha-numberic, jump to that\n\t\
+      \workspace. The workspace is created on-the-fly if such a workspace\n\t\
+      \does not exist.\n\n\t\
+
+      \If the second character typed is:\n\t\t\
+         \]: go to the next workspace\n\t\t\
+         \[: go to the previous workspace\n\t\t\
+         \}: cycle the workspaces on the screens to the right\n\t\t\
+         \{: cycle the workspaces on the screens to the left\n\t\t\
+         \<space>: Jump to the accompaning workspace.\n\t\t\
+         \F1: display this help.\n") $
+      mapNextStringWithKeysym $ \_ keysym str ->
+        case (keysym, str) of
+          (_, [ch]) | isAlphaNum ch -> gotoWorkspace ch
+          (_, "]") -> pushHistory $ withRelativeWorkspace next W.greedyView
+          (_, "[") -> pushHistory $ withRelativeWorkspace prev W.greedyView
+          (_, "}") -> windows screenRotateForward
+          (_, "{") -> windows screenRotateBackward
+          (_, " ") -> gotoAccompaningWorkspace
+
+          -- 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 ()
     shiftMod $
       doc "Move the currently focused window to another workspace" $
       mapNextString $ \_ str ->
         case str of
           [ch] | isAlphaNum ch -> shiftToWorkspace ch
+          "]" -> withRelativeWorkspace next W.shift
+          "[" -> withRelativeWorkspace prev W.shift
           _ -> return ()
     shiftAltMod $
       doc "Swap this workspace with another workspace (rename)." $
@@ -336,12 +361,12 @@ keymap = runKeys $ do
   bind xK_n $ do
     justMod $
       doc "Shift to the next workspace." $
-      relativeWorkspaceShift next
+      withRelativeWorkspace next W.greedyView
 
   bind xK_p $ do
     justMod $
       doc "Shift to the previous workspace." $
-      relativeWorkspaceShift prev
+      withRelativeWorkspace prev W.greedyView
 
   bind xK_plus $ do
     justMod $ 
@@ -566,10 +591,10 @@ mouseMap = runButtons $ do
     justMod $ \w -> focus w >> mouseResizeWindow w >> windows W.shiftMaster
 
   bind button6 $
-    justMod $ noWindow (relativeWorkspaceShift prev)
+    justMod $ noWindow (withRelativeWorkspace prev W.greedyView)
 
   bind button7 $
-    justMod $ noWindow (relativeWorkspaceShift next)
+    justMod $ noWindow (withRelativeWorkspace next W.greedyView)
 
   bind button8 $
     justMod $ noWindow mediaPrev
@@ -628,8 +653,8 @@ mouseMap = runButtons $ do
       let workspaceButtons = [
             (button2, swapMaster),
 
-            (button9, relativeWorkspaceShift next),
-            (button8, relativeWorkspaceShift prev),
+            (button9, withRelativeWorkspace next W.greedyView),
+            (button8, withRelativeWorkspace prev W.greedyView),
 
             (button4, windows W.focusUp),
             (button5, windows W.focusDown),
diff --git a/src/Internal/Lib.hs b/src/Internal/Lib.hs
index c29ca31..3ba858f 100644
--- a/src/Internal/Lib.hs
+++ b/src/Internal/Lib.hs
@@ -121,13 +121,13 @@ getString = runQuery $ do
       then t
       else printf "%s - %s" t a
 
-relativeWorkspaceShift :: Selector -> X ()
-relativeWorkspaceShift (Selector selector) = do
+withRelativeWorkspace :: Selector -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
+withRelativeWorkspace (Selector selector) fn =
   windows $ \ss ->
     let tags = sort (tag . snd  <$> filter (\x -> fst x /= Visible ) (getPopulatedWorkspaces ss))
         from = tag $ workspace $ current ss
         to = selector from tags
-    in greedyView to ss
+    in fn to ss
 
 next :: Selector
 next = Selector $ \a l -> select a l l
diff --git a/src/Internal/Submap.hs b/src/Internal/Submap.hs
index 32dda2a..0e54c43 100644
--- a/src/Internal/Submap.hs
+++ b/src/Internal/Submap.hs
@@ -1,5 +1,6 @@
 module Internal.Submap (
     mapNextString,
+    mapNextStringWithKeysym,
     submapButtonsWithKey,
     nextButton,
     nextMotion,
@@ -13,15 +14,20 @@ import Data.Map (Map)
 
 import XMonad.Actions.Submap as X
 
-{- Like submap fram XMonad.Actions.Submap, but sends the string from
- - XLookupString to the function rather than the KeySym.
+{-
+ - Like submap fram XMonad.Actions.Submap, but sends the string from
+ - XLookupString to the function along side the keysym.
+ -
+ - This function allows mappings where the mapped string might be important,
+ - but also allows submappings for keys that may not have a character associated
+ - with them (for example, the function keys).
  -}
-mapNextString :: (KeyMask -> String -> X a) -> X a
-mapNextString fn = do
+mapNextStringWithKeysym :: (KeyMask -> KeySym -> String -> X a) -> X a
+mapNextStringWithKeysym fn = do
   XConf { theRoot = root, display = d } <- ask
   io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
 
-  (m, str) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do
+  (m, str, keysym) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do
     maskEvent d keyPressMask p
     KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p
     keysym <- keycodeToKeysym d code 0
@@ -29,12 +35,17 @@ mapNextString fn = do
 
     if isModifierKey keysym
         then nextkey
-        else return (m, str)
+        else return (m, str, keysym)
 
   io $ ungrabKeyboard d currentTime
 
-  fn m str
+  fn m keysym str
 
+{- Like submap, but on the character typed rather than the kysym. -}
+mapNextString :: (KeyMask -> String -> X a) -> X a 
+mapNextString fn = mapNextStringWithKeysym (\m _ s -> fn m s)
+
+{- Grabs the mouse and returns the next button press. -}
 nextButton :: X (ButtonMask, Button)
 nextButton = do
   XConf { theRoot = root, display = d } <- ask
@@ -49,6 +60,7 @@ nextButton = do
 
   return ret
 
+{- Grabs the mouse and reports the next mouse motion. -}
 nextMotion :: X (Int, Int)
 nextMotion = do
   XConf { theRoot = root, display = d } <- ask
@@ -63,6 +75,7 @@ nextMotion = do
 
   return ret
 
+{- Grabs the mouse and reports the next mouse motion or button press. -}
 nextMotionOrButton :: X (Either (Int, Int) (ButtonMask, Button))
 nextMotionOrButton = do
   XConf { theRoot = root, display = d } <- ask