aboutsummaryrefslogtreecommitdiff
path: root/src/Rahm/Desktop
diff options
context:
space:
mode:
Diffstat (limited to 'src/Rahm/Desktop')
-rw-r--r--src/Rahm/Desktop/Common.hs8
-rw-r--r--src/Rahm/Desktop/History.hs158
-rw-r--r--src/Rahm/Desktop/Keys/Wml.hs12
3 files changed, 126 insertions, 52 deletions
diff --git a/src/Rahm/Desktop/Common.hs b/src/Rahm/Desktop/Common.hs
index 730a216..0ac41a7 100644
--- a/src/Rahm/Desktop/Common.hs
+++ b/src/Rahm/Desktop/Common.hs
@@ -7,6 +7,7 @@ module Rahm.Desktop.Common
windowJump,
withBorderColor,
withBorderWidth,
+ getCurrentScreen,
gotoWorkspace,
moveLocationToWorkspace,
getCurrentWorkspace,
@@ -37,7 +38,8 @@ import qualified Rahm.Desktop.StackSet as S
)
import Text.Printf (printf)
import XMonad
- ( Window,
+ ( ScreenId,
+ Window,
WorkspaceId,
X,
XConf (config, display),
@@ -169,6 +171,10 @@ getCurrentWorkspace = withWindowSet $
\(S.StackSet (S.Screen (S.Workspace t _ _) _ _) _ _ _) -> do
return t
+getCurrentScreen :: X ScreenId
+getCurrentScreen = withWindowSet $
+ \(S.StackSet (S.Screen _ sid _) _ _ _) -> return sid
+
getCurrentLocation :: X Location
getCurrentLocation = do
ws <- getCurrentWorkspace
diff --git a/src/Rahm/Desktop/History.hs b/src/Rahm/Desktop/History.hs
index e3b0927..dc6d6a1 100644
--- a/src/Rahm/Desktop/History.hs
+++ b/src/Rahm/Desktop/History.hs
@@ -4,24 +4,25 @@ module Rahm.Desktop.History
getZipper,
zipperBack,
zipperForward,
- pastHistory,
- getMostRecentLocationInHistory,
- historyBack,
- historyForward,
- lastLocation,
+ historyHook,
nextLocation,
jumpToLastLocation,
- historyHook,
+ lastLocation,
+ historyBack,
+ historyForward,
)
where
import Data.Default (Default (..))
import Data.Foldable (toList)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Maybe (fromMaybe)
import Data.Sequence (Seq (..))
import qualified Data.Sequence as Seq (length, (!?))
-import Rahm.Desktop.Common (Location (Location), focusLocation)
+import Rahm.Desktop.Common (Location (Location), focusLocation, getCurrentScreen)
import Text.Printf (printf)
-import XMonad (ExtensionClass (extensionType, initialValue), StateExtension (..), X)
+import XMonad (ExtensionClass (extensionType, initialValue), ScreenId, StateExtension (..), X)
import qualified XMonad.Util.ExtensibleState as XS
( get,
modify,
@@ -61,57 +62,124 @@ zipperForward :: BoundedSeqZipper a -> BoundedSeqZipper a
zipperForward (BoundedSeqZipper s (e :<| h) t) = BoundedSeqZipper s h (e :<| t)
zipperForward b = b
-newtype History = History
- { currentZipper :: BoundedSeqZipper Location
+data History = History
+ { historyByScreenId :: Map ScreenId (BoundedSeqZipper Location),
+ gobalHistory :: BoundedSeqZipper Location
}
deriving (Read, Show)
instance Default History where
- def = History (BoundedSeqZipper 1000 mempty mempty)
+ def = History mempty (BoundedSeqZipper 1000 mempty mempty)
instance ExtensionClass History where
initialValue = def
extensionType = PersistentExtension
-pastHistory :: Int -> X (Maybe Location)
-pastHistory i = do
- History (BoundedSeqZipper _ _ t) <- XS.get
- return $ t Seq.!? i
-
-getMostRecentLocationInHistory :: X (Maybe Location)
-getMostRecentLocationInHistory = do
- History z <- XS.get
- case z of
- (BoundedSeqZipper _ (_ :|> h) _) -> return $ Just h
- (BoundedSeqZipper _ _ (t :<| _)) -> return $ Just t
- _ -> return Nothing
-
-historyBack :: X ()
-historyBack = do
- History z <- XS.get
- let z' = zipperBack z
- mapM_ focusLocation (getZipper z')
- XS.put (History z')
-
-historyForward :: X ()
-historyForward = do
- History z <- XS.get
- let z' = zipperForward z
- mapM_ focusLocation (getZipper z')
- XS.put (History z')
+getCurrentZipper :: ScreenId -> History -> BoundedSeqZipper Location
+getCurrentZipper screenId (History byScreenId _) =
+ fromMaybe
+ (BoundedSeqZipper 1000 mempty mempty)
+ (Map.lookup screenId byScreenId)
+
+historyDo :: (forall a. BoundedSeqZipper a -> BoundedSeqZipper a) -> X ()
+historyDo f = do
+ screenId <- getCurrentScreen
+ History byScreenId gb <- XS.get
+ let mz' = Map.lookup screenId byScreenId
+ case mz' of
+ Nothing ->
+ return ()
+ Just z -> do
+ let z' = f z
+ mapM_ focusLocation (getZipper z')
+ XS.put
+ ( History (Map.insert screenId z' byScreenId) gb
+ )
+
+historyBack = historyDo zipperBack
+
+historyForward = historyDo zipperForward
+
+jumpToLastLocation :: X ()
+jumpToLastLocation = mapM_ focusLocation =<< lastLocation
+-- pastGlobalHistory :: Int -> X (Maybe Location)
+-- pastGlobalHistory i = do
+-- History (BoundedSeqZipper _ _ t) _ <- XS.get
+-- return $ t Seq.!? i
+--
+-- getMostRecentLocationInGlobalHistory :: X (Maybe Location)
+-- getMostRecentLocationInGlobalHistory = do
+-- History z _ <- XS.get
+-- case z of
+-- (BoundedSeqZipper _ (_ :|> h) _) -> return $ Just h
+-- (BoundedSeqZipper _ _ (t :<| _)) -> return $ Just t
+-- _ -> return Nothing
+--
+-- globalHistoryBack :: X ()
+-- globalHistoryBack = do
+-- History z _ <- XS.get
+-- let z' = zipperBack z
+-- mapM_ focusLocation (getZipper z')
+-- XS.put (History z')
+--
+-- globalHistoryForward :: X ()
+-- globalHistoryForward = do
+-- History z _ <- XS.get
+-- let z' = zipperForward z
+-- mapM_ focusLocation (getZipper z')
+-- XS.put (History z')
+--
+-- lastLocation :: X (Maybe Location)
+-- lastLocation = getZipper . zipperBack . currentZipper <$> XS.get
+--
+-- nextLocation :: X (Maybe Location)
+-- nextLocation = getZipper . zipperForward . currentZipper <$> XS.get
+--
+-- jumpToLastLocation :: X ()
+-- jumpToLastLocation = mapM_ focusLocation =<< lastLocation
+--
+
+-- Get the last location for the current screen.
lastLocation :: X (Maybe Location)
-lastLocation = getZipper . zipperBack . currentZipper <$> XS.get
+lastLocation = do
+ screenId <- getCurrentScreen
+ getZipper . zipperBack . getCurrentZipper screenId <$> XS.get
nextLocation :: X (Maybe Location)
-nextLocation = getZipper . zipperForward . currentZipper <$> XS.get
-
-jumpToLastLocation :: X ()
-jumpToLastLocation = mapM_ focusLocation =<< lastLocation
+nextLocation = do
+ screenId <- getCurrentScreen
+ getZipper . zipperForward . getCurrentZipper screenId <$> XS.get
historyHook :: Maybe Location -> Location -> X ()
-historyHook Nothing loc =
- XS.modify $ \(History z) -> History (pushZipper loc z)
+historyHook Nothing loc = do
+ currentScreen <- getCurrentScreen
+
+ XS.modify $ \(History byScreen global) ->
+ History
+ ( Map.alter
+ ( Just
+ . pushZipper loc
+ . fromMaybe (BoundedSeqZipper 1000 mempty mempty)
+ )
+ currentScreen
+ byScreen
+ )
+ (pushZipper loc global)
+-- History hook where the 'from' location workspace does not match the 'to'
+-- location workspace.
historyHook (Just (Location ws _)) l@(Location ws' _) | ws /= ws' = do
- XS.modify $ \(History z) -> History (pushZipper l z)
+ currentScreen <- getCurrentScreen
+
+ XS.modify $ \(History byScreen z) ->
+ History
+ ( Map.alter
+ ( Just
+ . pushZipper l
+ . fromMaybe (BoundedSeqZipper 1000 mempty mempty)
+ )
+ currentScreen
+ byScreen
+ )
+ (pushZipper l z)
historyHook _ _ = return ()
diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index 71551e8..e7a7cb9 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -71,10 +71,10 @@ import Rahm.Desktop.Common
windowsInWorkspace,
)
import Rahm.Desktop.History
- ( getMostRecentLocationInHistory,
+ ( -- getMostRecentLocationInHistory,
lastLocation,
nextLocation,
- pastHistory,
+ -- pastHistory,
)
import Rahm.Desktop.Logger (LogLevel (Info, Trace), logs)
import Rahm.Desktop.Marking
@@ -543,11 +543,11 @@ readNextLocationSet =
-- A character is the base-case. Refers to a collection of windows.
(_, _, [ch]) | isAlpha ch -> mt $ getMarkedLocations [ch]
-- Goes to the most recent location in history.
- (_, _, "0") -> (: []) <$> MaybeT (fromX getMostRecentLocationInHistory)
+ -- (_, _, "0") -> (: []) <$> MaybeT (fromX getMostRecentLocationInHistory)
-- A Digit goes to the past history.
- (_, _, [ch])
- | isDigit ch ->
- (: []) <$> MaybeT (fromX $ pastHistory (ord ch - 0x30))
+ -- (_, _, [ch])
+ -- | isDigit ch ->
+ -- (: []) <$> MaybeT (fromX $ pastHistory (ord ch - 0x30))
-- The current window.
(_, _, ".") -> (: []) <$> mt getCurrentLocation
-- The window on the far-left of the screens.
generated by cgit (git 2.34.1) at 2026-02-22 15:53:28 +0000