aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Internal/Keys.hs23
-rw-r--r--src/Internal/Lib.hs9
-rw-r--r--src/Internal/Marking.hs112
3 files changed, 111 insertions, 33 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..89d4a0b 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,20 +28,68 @@ 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 MarkState =
MarkState {
markStateMap :: Map Mark Window
- , markLast :: Maybe Window
+ , windowHistory :: History Window
} deriving (Read, Show)
instance ExtensionClass MarkState where
- initialValue = MarkState Map.empty Nothing
+ initialValue = MarkState Map.empty def
+
+changeHistory :: (History Window -> History Window) -> (MarkState -> MarkState)
+changeHistory fn ms = ms { windowHistory = fn (windowHistory ms)}
+
+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
@@ -45,16 +101,26 @@ 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
+ withFocused $ \windowBefore -> do
+ withHistory $ \hist ->
+ XS.modify $ changeHistory (historyPush windowBefore)
+
+ fn
+
+ withFocused $ \windowAfter ->
+ XS.modify $ changeHistory (historyPush windowAfter)
+
+withHistory :: (History Window -> 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
@@ -62,7 +128,7 @@ jumpToMark mark = do
case Map.lookup mark m of
Nothing -> return ()
Just w -> do
- saveLastMark
+ XS.modify $ changeHistory (historyPush w)
greedyFocus w
setFocusedWindow :: a -> StackSet i l a s sd -> StackSet i l a s sd
@@ -85,20 +151,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
Nothing -> return ()
- Just win -> windows $ swapWithFocused win
+ 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