Merge branch 'v017' of josher.dev:rde into v017

3 files changed, 145 insertions, 41 deletions

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 961bfc5..3f9882b 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -290,11 +290,17 @@ keymap = runKeys $ do
       doc "Shrink the size of the zoom region" $
       sendMessage ShrinkZoom
 
+    shiftMod $
+      doc "Go to the previous window in history." historyPrev
+
   bind xK_k $ do
     justMod $
       doc "Expand the size of the zoom region" $
       sendMessage ExpandZoom
 
+    shiftMod $
+      doc "Go to the next window in history." historyNext
+
   bind xK_l $ do
     justMod    $
       doc "Focus the next window in the stack" $
@@ -420,18 +426,19 @@ keymap = runKeys $ do
                 _ -> return ()
 
         bind xK_p $ do
-          (justMod -|- noMod) $ mapNextString $ \_ str ->
-            spawnX $ printf "gxmessage 'typed: \"%s\"\ncodes: \"%s\"\nunicode: á\n'"
-              str
-              (show (map ord str))
+          (justMod -|- noMod) $
+            doc "Go to the prior window in the history" historyPrev
 
         bind xK_t $ do
           (justMod -|- noMod) $ logs "Test Log"
 
+        -- bind xK_n $ do
+        --   (justMod -|- noMod) $
+        --     doc "Take a note" $
+        --     spawnX (terminal config ++ " -t Notes -e notes new")
         bind xK_n $ do
           (justMod -|- noMod) $
-            doc "Take a note" $
-            spawnX (terminal config ++ " -t Notes -e notes new")
+            doc "Go to the next window in the history" historyNext
 
         bind xK_c $ do
           shiftMod $
@@ -589,8 +596,8 @@ mouseMap = runButtons $ do
             (button4, increaseVolume),
             (button5, decreaseVolume),
             (button2, playPause),
-            (button9, mediaNext),
-            (button8, mediaPrev),
+            (button9, historyNext),
+            (button8, historyPrev),
             (button6, mediaPrev),
             (button7, mediaNext)
             ]
diff --git a/src/Internal/Lib.hs b/src/Internal/Lib.hs
index e608bb0..c29ca31 100644
--- a/src/Internal/Lib.hs
+++ b/src/Internal/Lib.hs
@@ -77,8 +77,7 @@ gotoAccompaningWorkspace = do
     else gotoWorkspace (toUpper cur)
 
 gotoWorkspace :: WorkspaceName -> X ()
-gotoWorkspace ch = do
-  saveLastMark
+gotoWorkspace ch = pushHistory $ do
   addHiddenWorkspace [ch]
   windows $ greedyView $ return ch
 
@@ -149,7 +148,7 @@ withScreen fn n = do
       Just screen -> fn (tag $ workspace screen) windowSet
 
 windowJump :: X ()
-windowJump = do
+windowJump = pushHistory $ do
   windowTitlesToWinId <- withWindowSet $ \ss ->
     Map.fromList <$> mapM (\wid -> (,) <$> getString wid <*> return wid) (allWindows ss)
 
@@ -157,6 +156,4 @@ windowJump = do
 
   case windowId of
     Nothing -> return ()
-    Just wid -> do
-      saveLastMark
-      focus wid
+    Just wid -> focus wid
diff --git a/src/Internal/Marking.hs b/src/Internal/Marking.hs
index dcf3c05..3ffb411 100644
--- a/src/Internal/Marking.hs
+++ b/src/Internal/Marking.hs
@@ -1,16 +1,24 @@
 {-# LANGUAGE ScopedTypeVariables #-}
-module Internal.Marking where
+module Internal.Marking (
+  historyNext, historyPrev,
+  markCurrentWindow, pushHistory,
+  jumpToMark, jumpToLast, swapWithLastMark,
+  swapWithMark
+  ) where
 
 import Internal.Windows (mapWindows, findWindow, getLocationWorkspace)
 import XMonad
 import XMonad.StackSet hiding (focus)
 import Data.IORef
 import Data.Map (Map)
+import Control.Monad (when)
 
 import System.FilePath
 import System.IO
 import Control.Exception
 import System.Environment
+import qualified Data.Sequence as Seq
+import Data.Sequence (Seq(..))
 
 import qualified XMonad.Util.ExtensibleState as XS
 
@@ -20,22 +28,88 @@ import qualified Data.Map as Map
 
 type Mark = Char
 
+historySize = 100 -- max number of history elements the tail.
+
+data History a = History [a] (Seq a)
+  deriving (Read, Show)
+
+instance Default (History a) where
+  
+  def = History [] Seq.empty
+
+seqPush :: a -> Seq a -> Seq a
+seqPush elem s@(seq :|> _) | Seq.length s >= historySize = elem :<| seq
+seqPush elem s = elem :<| s
+
+historyForward :: History a -> History a
+historyForward (History (a:as) tail) = History as (seqPush a tail)
+historyForward z = z
+
+historyBackward :: History a -> History a
+historyBackward (History head (a :<| as)) = History (a : head) as
+historyBackward z = z
+
+historyCurrent :: History a -> Maybe a
+historyCurrent (History (a:_) _) = Just a
+historyCurrent _ = Nothing
+
+historyPush :: (Eq a) => a -> History a -> History a
+historyPush a h@(History (w : _) _) | a == w = h
+historyPush a (History (w : _) tail) = History [a] (seqPush w tail)
+historyPush a (History _ tail) = History [a] tail
+
+historySwap :: History a -> History a
+historySwap (History (a:as) (t :<| ts)) = History (t : as) (seqPush a ts)
+historySwap z = z
+
+historyLast :: History a -> Maybe a
+historyLast (History _ (t :<| _)) = Just t
+historyLast _ = Nothing
+
+data Spot =
+        WindowSpot Window | -- Focus is on a window.
+        TagSpot String -- Focus is on an (empty) tag
+        deriving (Read, Show, Eq, Ord)
+
+greedyFocus :: Spot -> X ()
+greedyFocus (WindowSpot win) = do
+     ws <- withWindowSet $ \ss ->
+             return $ getLocationWorkspace =<< findWindow ss win
+ 
+     mapM_ (windows . greedyView . tag) ws
+     focus win
+greedyFocus (TagSpot tag) =
+  windows $ greedyView tag
+
 data MarkState =
   MarkState {
     markStateMap :: Map Mark Window
-  , markLast :: Maybe Window
+  , windowHistory :: History Spot
   } deriving (Read, Show)
 
 
 instance ExtensionClass MarkState where
-  initialValue = MarkState Map.empty Nothing
+  initialValue = MarkState Map.empty def
+  extensionType = PersistentExtension
+
+changeHistory :: (History Spot -> History Spot) -> (MarkState -> MarkState)
+changeHistory fn ms = ms { windowHistory = fn (windowHistory ms)}
+
+withMaybeFocused :: (Maybe Window -> X ()) -> X ()
+withMaybeFocused f = withWindowSet $ f . peek
 
-greedyFocus :: Window -> X ()
-greedyFocus win = do
-    ws <- withWindowSet $ \ss ->
-            return $ getLocationWorkspace =<< findWindow ss win
-    mapM_ (windows . greedyView . tag) ws
-    focus win
+normalizeWindows :: X ()
+normalizeWindows = do
+  MarkState { windowHistory = h } <- XS.get
+  mapM_ greedyFocus (historyCurrent h)
+
+-- greedyFocus :: Window -> X ()
+-- greedyFocus win = do
+--     ws <- withWindowSet $ \ss ->
+--             return $ getLocationWorkspace =<< findWindow ss win
+-- 
+--     mapM_ (windows . greedyView . tag) ws
+--     focus win
 
 markCurrentWindow :: Mark -> X ()
 markCurrentWindow mark = do
@@ -45,25 +119,43 @@ markCurrentWindow mark = do
           markStateMap = Map.insert mark win ms
         }
 
-saveLastMark :: X ()
-saveLastMark =
-  withFocused $ \win ->
-      XS.modify $ \state -> state { markLast = Just win }
+pushHistory :: X () -> X ()
+pushHistory fn = do
+  withMaybeFocused $ \maybeWindowBefore -> do
+    case maybeWindowBefore of
+      (Just windowBefore) ->
+        XS.modify $ changeHistory (historyPush (WindowSpot windowBefore))
+      Nothing -> 
+        withWindowSet $ \ws ->
+          XS.modify $ changeHistory (historyPush (TagSpot (currentTag ws)))
+
+    fn
+
+    withMaybeFocused $ \maybeWindowAfter ->
+      case maybeWindowAfter of
+        Just windowAfter ->
+          XS.modify $ changeHistory (historyPush $ WindowSpot windowAfter)
+        Nothing ->
+          withWindowSet $ \ws ->
+            XS.modify $ changeHistory (historyPush $ TagSpot $ currentTag ws)
+
+withHistory :: (History Spot -> X ()) -> X ()
+withHistory fn = do
+  MarkState { windowHistory = w } <- XS.get
+  fn w
 
 jumpToLast :: X ()
 jumpToLast = do
-  m <- markLast <$> XS.get
-  saveLastMark
-  mapM_ greedyFocus m
+  XS.modify (changeHistory historySwap)
+  normalizeWindows
 
 jumpToMark :: Mark -> X ()
 jumpToMark mark = do
   MarkState {markStateMap = m} <- XS.get
   case Map.lookup mark m of
     Nothing -> return ()
-    Just w -> do
-      saveLastMark
-      greedyFocus w
+    Just w -> pushHistory $
+      greedyFocus (WindowSpot w)
 
 setFocusedWindow :: a -> StackSet i l a s sd -> StackSet i l a s sd
 setFocusedWindow
@@ -85,20 +177,28 @@ swapWithFocused winToSwap stackSet =
             \w -> if w == winToSwap then focused else w) stackSet
 
 swapWithLastMark :: X ()
-swapWithLastMark = do
-  m <- markLast <$> XS.get
-  saveLastMark
+swapWithLastMark = pushHistory $ withHistory $ \hist -> do
 
-  case m of
+  case historyLast hist of
+    Just (WindowSpot win) ->
+      windows $ swapWithFocused win
     Nothing -> return ()
-    Just win -> windows $ swapWithFocused win
 
 swapWithMark :: Mark -> X ()
-swapWithMark mark = do
+swapWithMark mark = pushHistory $ do
   MarkState {markStateMap = m} <- XS.get
-  saveLastMark
 
   case Map.lookup mark m of
     Nothing -> return ()
-    Just winToSwap ->
+    Just winToSwap -> do
       windows $ swapWithFocused winToSwap
+
+historyPrev :: X ()
+historyPrev = do
+  XS.modify $ changeHistory historyBackward
+  normalizeWindows
+
+historyNext :: X ()
+historyNext = do
+  XS.modify $ changeHistory historyForward
+  normalizeWindows