diff options
| author | Josh Rahm <joshuarahm@gmail.com> | 2022-04-15 23:55:35 -0600 |
|---|---|---|
| committer | Josh Rahm <joshuarahm@gmail.com> | 2022-10-09 12:19:46 -0600 |
| commit | 9e5d56cfb2508d9f5e58bf681265d0f1070b3f35 (patch) | |
| tree | 7b8ed1b605636fb67b11999bad5e45d48d08f90b /src/Rahm/Desktop/Marking.hs | |
| parent | 73fe77966c249283655495e144de3c36c25e533d (diff) | |
| download | rde-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.hs | 124 |
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 |