From 9b5a7b99d33891f0bc664316c643337ac638cbae Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Mon, 4 Apr 2022 17:21:16 -0600 Subject: Implement a window history system. This lets the user cycle between past windows. The rules for when a window gets added to the history is the same as when a window is considered the last marked. In fact, now all the last mark does is swap the current window with the previous one in the history. --- src/Internal/Marking.hs | 112 ++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 93 insertions(+), 19 deletions(-) (limited to 'src/Internal/Marking.hs') 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 -- cgit From 522a993840f5fd8fd414c54a00b871ec2689216f Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Mon, 4 Apr 2022 17:27:52 -0600 Subject: change markstate to be persistent --- src/Internal/Marking.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'src/Internal/Marking.hs') diff --git a/src/Internal/Marking.hs b/src/Internal/Marking.hs index 89d4a0b..9bf58cd 100644 --- a/src/Internal/Marking.hs +++ b/src/Internal/Marking.hs @@ -76,6 +76,7 @@ data MarkState = instance ExtensionClass MarkState where initialValue = MarkState Map.empty def + extensionType = PersistentExtension changeHistory :: (History Window -> History Window) -> (MarkState -> MarkState) changeHistory fn ms = ms { windowHistory = fn (windowHistory ms)} -- cgit From 20aaf1e159b6128ad136c0bcf489c0ac0ebc76f5 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Mon, 4 Apr 2022 17:49:01 -0600 Subject: Make both Tags and Windows as valid history targets --- src/Internal/Marking.hs | 65 ++++++++++++++++++++++++++++++++++--------------- 1 file changed, 45 insertions(+), 20 deletions(-) (limited to 'src/Internal/Marking.hs') diff --git a/src/Internal/Marking.hs b/src/Internal/Marking.hs index 9bf58cd..3ffb411 100644 --- a/src/Internal/Marking.hs +++ b/src/Internal/Marking.hs @@ -66,11 +66,25 @@ 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 Window + , windowHistory :: History Spot } deriving (Read, Show) @@ -78,21 +92,24 @@ instance ExtensionClass MarkState where initialValue = MarkState Map.empty def extensionType = PersistentExtension -changeHistory :: (History Window -> History Window) -> (MarkState -> MarkState) +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 + 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 +-- 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 @@ -104,16 +121,25 @@ markCurrentWindow mark = do pushHistory :: X () -> X () pushHistory fn = do - withFocused $ \windowBefore -> do - withHistory $ \hist -> - XS.modify $ changeHistory (historyPush windowBefore) + 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 - withFocused $ \windowAfter -> - XS.modify $ changeHistory (historyPush windowAfter) + 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 Window -> X ()) -> X () +withHistory :: (History Spot -> X ()) -> X () withHistory fn = do MarkState { windowHistory = w } <- XS.get fn w @@ -128,9 +154,8 @@ jumpToMark mark = do MarkState {markStateMap = m} <- XS.get case Map.lookup mark m of Nothing -> return () - Just w -> do - XS.modify $ changeHistory (historyPush w) - greedyFocus w + Just w -> pushHistory $ + greedyFocus (WindowSpot w) setFocusedWindow :: a -> StackSet i l a s sd -> StackSet i l a s sd setFocusedWindow @@ -155,9 +180,9 @@ swapWithLastMark :: X () swapWithLastMark = pushHistory $ withHistory $ \hist -> do case historyLast hist of - Nothing -> return () - Just win -> + Just (WindowSpot win) -> windows $ swapWithFocused win + Nothing -> return () swapWithMark :: Mark -> X () swapWithMark mark = pushHistory $ do -- cgit