aboutsummaryrefslogtreecommitdiff
path: root/src/Rahm/Desktop/Marking.hs
diff options
context:
space:
mode:
authorJosh Rahm <joshuarahm@gmail.com>2022-04-15 23:55:35 -0600
committerJosh Rahm <joshuarahm@gmail.com>2022-10-09 12:19:46 -0600
commit9e5d56cfb2508d9f5e58bf681265d0f1070b3f35 (patch)
tree7b8ed1b605636fb67b11999bad5e45d48d08f90b /src/Rahm/Desktop/Marking.hs
parent73fe77966c249283655495e144de3c36c25e533d (diff)
downloadrde-9e5d56cfb2508d9f5e58bf681265d0f1070b3f35.tar.gz
rde-9e5d56cfb2508d9f5e58bf681265d0f1070b3f35.tar.bz2
rde-9e5d56cfb2508d9f5e58bf681265d0f1070b3f35.zip
Make history much, much more reliable.
This time history is being done using a hook to keep track of history. This means I don't have to manually call pushHistory every time I focus a new window.
Diffstat (limited to 'src/Rahm/Desktop/Marking.hs')
-rw-r--r--src/Rahm/Desktop/Marking.hs124
1 files changed, 5 insertions, 119 deletions
diff --git a/src/Rahm/Desktop/Marking.hs b/src/Rahm/Desktop/Marking.hs
index 98c96bb..639aae2 100644
--- a/src/Rahm/Desktop/Marking.hs
+++ b/src/Rahm/Desktop/Marking.hs
@@ -1,7 +1,6 @@
module Rahm.Desktop.Marking (
- historyNext, historyPrev,
- markCurrentWindow, pushHistory,
- jumpToMark, jumpToLast, swapWithLastMark,
+ markCurrentWindow,
+ jumpToMark,
swapWithMark, markToWindow
) where
@@ -27,81 +26,19 @@ 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
- , windowHistory :: History Spot
} deriving (Read, Show)
instance ExtensionClass MarkState where
- initialValue = MarkState Map.empty def
+ initialValue = MarkState Map.empty
extensionType = PersistentExtension
-changeHistory :: (History Spot -> History Spot) -> (MarkState -> MarkState)
-changeHistory fn ms = ms { windowHistory = fn (windowHistory ms)}
-
withMaybeFocused :: (Maybe Window -> X a) -> X a
withMaybeFocused f = withWindowSet $ f . peek
-normalizeWindows :: X ()
-normalizeWindows = do
- MarkState { windowHistory = h } <- XS.get
- mapM_ greedyFocus (historyCurrent h)
-
-- greedyFocus :: Window -> X ()
-- greedyFocus win = do
-- ws <- withWindowSet $ \ss ->
@@ -118,45 +55,12 @@ markCurrentWindow mark = do
markStateMap = Map.insert mark win ms
}
-pushHistory :: X a -> X a
-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)))
-
- ret <- fn
-
- withMaybeFocused $ \maybeWindowAfter ->
- case maybeWindowAfter of
- Just windowAfter ->
- XS.modify $ changeHistory (historyPush $ WindowSpot windowAfter)
- Nothing ->
- withWindowSet $ \ws ->
- XS.modify $ changeHistory (historyPush $ TagSpot $ currentTag ws)
-
- return ret
-
-withHistory :: (History Spot -> X ()) -> X ()
-withHistory fn = do
- MarkState { windowHistory = w } <- XS.get
- fn w
-
-jumpToLast :: X ()
-jumpToLast = do
- 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 -> pushHistory $
- greedyFocus (WindowSpot w)
+ Just w -> windows $ focusWindow w
setFocusedWindow :: a -> StackSet i l a s sd -> StackSet i l a s sd
setFocusedWindow
@@ -177,34 +81,16 @@ swapWithFocused winToSwap stackSet =
mapWindows (
\w -> if w == winToSwap then focused else w) stackSet
-swapWithLastMark :: X ()
-swapWithLastMark = pushHistory $ withHistory $ \hist -> do
-
- case historyLast hist of
- Just (WindowSpot win) ->
- windows $ swapWithFocused win
- Nothing -> return ()
-
markToWindow :: Mark -> X (Maybe Window)
markToWindow m = do
MarkState { markStateMap = mp } <- XS.get
return $ Map.lookup m mp
swapWithMark :: Mark -> X ()
-swapWithMark mark = pushHistory $ do
+swapWithMark mark = do
MarkState {markStateMap = m} <- XS.get
case Map.lookup mark m of
Nothing -> return ()
Just winToSwap -> do
windows $ swapWithFocused winToSwap
-
-historyPrev :: X ()
-historyPrev = do
- XS.modify $ changeHistory historyBackward
- normalizeWindows
-
-historyNext :: X ()
-historyNext = do
- XS.modify $ changeHistory historyForward
- normalizeWindows