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/Keys.hs | 23 ++++++---- src/Internal/Lib.hs | 9 ++-- src/Internal/Marking.hs | 112 ++++++++++++++++++++++++++++++++++++++++-------- 3 files changed, 111 insertions(+), 33 deletions(-) (limited to 'src') diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs index 6d34c4a..2dd7c37 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 -- 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') 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') 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