aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJosh Rahm <joshuarahm@gmail.com>2022-04-16 11:35:09 -0600
committerJosh Rahm <joshuarahm@gmail.com>2022-04-16 11:35:09 -0600
commit4114631cb78f5c21a70ae5fe697b8230e965c1fb (patch)
tree6baf9a882b5df229d648df3ecb956ca5313bc791 /src
parente7d0c65ef807cf6d595273a764ec95d17c8708b5 (diff)
parent65456557536f7886ae079fa2b980a1ef7f0619c0 (diff)
downloadrde-4114631cb78f5c21a70ae5fe697b8230e965c1fb.tar.gz
rde-4114631cb78f5c21a70ae5fe697b8230e965c1fb.tar.bz2
rde-4114631cb78f5c21a70ae5fe697b8230e965c1fb.zip
Merge branch 'v017' of josher.dev:rde into v017
Diffstat (limited to 'src')
-rw-r--r--src/Main.hs11
-rw-r--r--src/Rahm/Desktop/History.hs92
-rw-r--r--src/Rahm/Desktop/Hooks/WindowChange.hs45
-rw-r--r--src/Rahm/Desktop/Keys.hs51
-rw-r--r--src/Rahm/Desktop/Layout.hs4
-rw-r--r--src/Rahm/Desktop/Layout/ConsistentMosaic.hs4
-rw-r--r--src/Rahm/Desktop/Layout/Flip.hs2
-rw-r--r--src/Rahm/Desktop/Layout/Hole.hs4
-rw-r--r--src/Rahm/Desktop/Layout/List.hs4
-rw-r--r--src/Rahm/Desktop/Layout/Pop.hs4
-rw-r--r--src/Rahm/Desktop/Layout/Redescribe.hs2
-rw-r--r--src/Rahm/Desktop/Layout/ReinterpretMessage.hs2
-rw-r--r--src/Rahm/Desktop/Lib.hs4
-rw-r--r--src/Rahm/Desktop/Marking.hs126
-rw-r--r--src/Rahm/Desktop/Submap.hs6
-rw-r--r--src/Rahm/Desktop/Workspaces.hs6
-rw-r--r--src/Rahm/Desktop/XMobarLog.hs6
17 files changed, 209 insertions, 164 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 56c66f5..edce3fb 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -11,6 +11,7 @@ import XMonad.Layout.Fullscreen (fullscreenEventHook)
import System.Environment (setEnv)
import Data.Monoid
import qualified Data.Map as Map
+import Text.Printf
import Rahm.Desktop.Swallow
import Rahm.Desktop.Windows
@@ -20,6 +21,8 @@ import Rahm.Desktop.Layout
import Rahm.Desktop.Logger
import Rahm.Desktop.DMenu (menuCommandString)
import Rahm.Desktop.RebindKeys
+import Rahm.Desktop.Hooks.WindowChange
+import Rahm.Desktop.History
import qualified XMonad as X
import qualified XMonad.StackSet as W
@@ -35,8 +38,8 @@ main = do
xmobar <- spawnXMobar
- (=<<) X.xmonad $
- applyKeys $ ewmh $ docks $ def
+ (=<<) X.xmonad $
+ applyKeys $ withLocationChangeHook historyHook $ ewmh $ docks $ def
{ terminal = "alacritty"
, modMask = mod3Mask
, borderWidth = 2
@@ -75,6 +78,10 @@ main = do
}
+changeHook :: Location -> Location -> X ()
+changeHook l1 l2 = do
+ logs $ printf "Change %s -> %s" (show l1) (show l2)
+
doCenterFloat :: ManageHook
doCenterFloat =
ask >>= \w -> doF . W.float w . centerRect . snd =<< liftX (floatLocation w)
diff --git a/src/Rahm/Desktop/History.hs b/src/Rahm/Desktop/History.hs
new file mode 100644
index 0000000..5e15fe6
--- /dev/null
+++ b/src/Rahm/Desktop/History.hs
@@ -0,0 +1,92 @@
+module Rahm.Desktop.History where
+
+import XMonad
+import Text.Printf
+import qualified XMonad.StackSet as W
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
+import Data.Default
+import qualified XMonad.Util.ExtensibleState as XS
+
+import Data.Foldable (toList)
+import Rahm.Desktop.Workspaces (gotoWorkspace)
+import Rahm.Desktop.Hooks.WindowChange
+import Rahm.Desktop.Logger
+import Rahm.Desktop.Marking
+import Data.Sequence (Seq(..))
+import qualified Data.Sequence as Seq
+
+data BoundedSeqZipper a = BoundedSeqZipper Int (Seq a) (Seq a)
+ deriving (Eq, Show, Ord, Read)
+
+instance Functor BoundedSeqZipper where
+ fmap fn (BoundedSeqZipper i h t) = BoundedSeqZipper i (fmap fn h) (fmap fn t)
+
+zipperDbgPrint :: (Show a) => BoundedSeqZipper a -> String
+zipperDbgPrint (BoundedSeqZipper _ h (c :<| t)) =
+ concat $
+ map (printf " %s " . show) (toList h) ++
+ [printf "[%s]" (show c)] ++
+ map (printf " %s " . show) (toList t)
+zipperDbgPrint _ = "<empty>"
+
+pushZipper :: a -> BoundedSeqZipper a -> BoundedSeqZipper a
+pushZipper e (BoundedSeqZipper maxSize _ (tail :|> _))
+ | maxSize <= Seq.length tail =
+ BoundedSeqZipper maxSize mempty (e :<| tail)
+pushZipper e (BoundedSeqZipper maxSize _ tail) =
+ BoundedSeqZipper maxSize mempty (e :<| tail)
+
+getZipper :: BoundedSeqZipper a -> Maybe a
+getZipper (BoundedSeqZipper _ _ (e :<| _)) = Just e
+getZipper _ = Nothing
+
+zipperBack :: BoundedSeqZipper a -> BoundedSeqZipper a
+zipperBack (BoundedSeqZipper s h (e :<| t)) = BoundedSeqZipper s (e :<| h) t
+zipperBack b = b
+
+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
+} deriving (Read, Show)
+
+instance Default History where
+ def = History (BoundedSeqZipper 1000 mempty mempty)
+
+instance ExtensionClass History where
+ initialValue = def
+ -- extensionType = PersistentExtension
+
+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')
+
+lastWindow :: X (Maybe Location)
+lastWindow = getZipper . zipperBack . currentZipper <$> XS.get
+
+jumpToLastLocation :: X ()
+jumpToLastLocation = mapM_ focusLocation =<< lastWindow
+
+
+historyHook :: Location -> Location -> X ()
+historyHook (Location ws _) l@(Location ws' _) | ws /= ws' = do
+ XS.modify $ \(History z) -> History (pushZipper l z)
+
+historyHook _ _ = return ()
+
+focusLocation :: Location -> X ()
+focusLocation (Location ws Nothing) = gotoWorkspace ws
+focusLocation (Location _ (Just win)) = windows $ W.focusWindow win
diff --git a/src/Rahm/Desktop/Hooks/WindowChange.hs b/src/Rahm/Desktop/Hooks/WindowChange.hs
new file mode 100644
index 0000000..0038f47
--- /dev/null
+++ b/src/Rahm/Desktop/Hooks/WindowChange.hs
@@ -0,0 +1,45 @@
+module Rahm.Desktop.Hooks.WindowChange where
+
+import XMonad
+import Control.Monad
+import qualified XMonad.Util.ExtensibleState as XS
+import Data.Default
+import Rahm.Desktop.Workspaces
+
+import qualified XMonad.StackSet as W
+
+data Location = Location WorkspaceId (Maybe Window)
+ deriving (Read, Show, Eq)
+
+newtype LastLocation = LastLocation (Maybe Location)
+ deriving (Read, Show)
+
+instance Default LastLocation where
+ def = LastLocation Nothing
+
+instance ExtensionClass LastLocation where
+ initialValue = def
+ extensionType = PersistentExtension
+
+-- Creates a log hook from the function provided.
+--
+-- The first argument to the function is the old window, the second argument in
+-- the new window.
+withLocationChangeHook :: (Location -> Location -> X ()) -> XConfig l -> XConfig l
+withLocationChangeHook fn config =
+ config {
+ logHook = do
+ logHook config
+
+ currentLocation <-
+ Location <$> getCurrentWorkspace <*> withWindowSet (return . W.peek)
+
+ LastLocation last <- XS.get
+
+ whenJust last $ \lastLocation ->
+ when (lastLocation /= currentLocation) $
+ fn lastLocation currentLocation
+
+ XS.put $ LastLocation $ Just currentLocation
+ return ()
+ }
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 6912473..74960df 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -62,6 +62,7 @@ import Rahm.Desktop.Swallow
import Rahm.Desktop.SwapMaster (swapMaster)
import Rahm.Desktop.Windows
import Rahm.Desktop.Workspaces
+import Rahm.Desktop.History
type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ())
type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ())
@@ -143,10 +144,10 @@ keymap = runKeys $ do
doc "Jumps between marks." $
mapNextString $ \_ str ->
case str of
- ['\''] -> jumpToLast
+ ['\''] -> jumpToLastLocation
[ch] | isAlphaNum ch -> jumpToMark ch
- "[" -> historyPrev
- "]" -> historyNext
+ "[" -> historyBack
+ "]" -> historyForward
_ -> return ()
shiftMod $
@@ -162,7 +163,7 @@ keymap = runKeys $ do
doc "Swap the current window with a mark." $
mapNextString $ \_ str ->
case str of
- ['\''] -> swapWithLastMark
+ -- ['\''] -> swapWithLastMark
[ch] | isAlphaNum ch -> swapWithMark ch
_ -> return ()
@@ -291,7 +292,7 @@ keymap = runKeys $ do
(MaybeT . workspaceWithWindow) =<< MaybeT askWindowId)
(_, " ") -> Just $ accompaningWorkspace <$> getCurrentWorkspace
_ -> Nothing
-
+
justMod $
doc "Goto/Send/Etc To a workspace\n\n\t\
@@ -315,10 +316,10 @@ keymap = runKeys $ do
\F1: display this help.\n\n\t" $
mapNextStringWithKeysym $ \_ keysym str ->
case ((keysym, str), selectWorkspace (keysym, str)) of
- (_, Just w) -> pushHistory $ gotoWorkspace =<< w
+ (_, Just w) -> gotoWorkspace =<< w
-- Test binding. Tests that I can still submap keysyms alone (keys
-- where XLookupString won't return anything helpful.)
- ((f, _), _) | f == xK_F1 ->
+ ((f, _), _) | f == xK_F1 ->
(safeSpawn "gxmessage" [
"-fn", "Source Code Pro",
documentation (keymap config)] :: X ())
@@ -336,7 +337,7 @@ keymap = runKeys $ do
doc "Move the current focused window to another workspace and view that workspace" $
mapNextStringWithKeysym $ \_ keysym str ->
case ((keysym, str), selectWorkspace (keysym, str)) of
- (_, Just w) -> pushHistory $ do
+ (_, Just w) -> do
ws <- w
shiftToWorkspace ws
gotoWorkspace ws
@@ -377,7 +378,7 @@ keymap = runKeys $ do
sendMessage Shrink
shiftMod $
- doc "Go to the previous window in history." historyPrev
+ doc "Go to the previous window in history." historyBack
bind xK_k $ do
justMod $
@@ -385,7 +386,7 @@ keymap = runKeys $ do
sendMessage Expand
shiftMod $
- doc "Go to the next window in history." historyNext
+ doc "Go to the next window in history." historyForward
bind xK_l $ do
justMod $
@@ -455,7 +456,7 @@ keymap = runKeys $ do
bind xK_space $ do
justMod $ doc "Layout-related bindings" $ subkeys $ do
-
+
bind xK_n $
(noMod -|- justMod) $ doc "Use the next layout in the layout list." $
sendMessage toNextLayout
@@ -551,7 +552,7 @@ keymap = runKeys $ do
bind xK_p $ do
(justMod -|- noMod) $
- doc "Go to the prior window in the history" historyPrev
+ doc "Go to the prior window in the history" historyBack
bind xK_t $ do
(justMod -|- noMod) $ logs "Test Log"
@@ -562,7 +563,7 @@ keymap = runKeys $ do
-- spawnX (terminal config ++ " -t Notes -e notes new")
bind xK_n $ do
(justMod -|- noMod) $
- doc "Go to the next window in the history" historyNext
+ doc "Go to the next window in the history" historyForward
bind xK_c $ do
shiftMod $
@@ -606,6 +607,20 @@ keymap = runKeys $ do
doc "Set the volume of an application via rofi." $
spawnX "set-volume.sh -a"
+ let navigateHistory = repeatable $ do
+ bind xK_bracketright $ do
+ noMod $
+ doc "Move forward in location history" historyForward
+
+ bind xK_bracketleft $ do
+ noMod $
+ doc "Move backward in location history" historyBack
+
+ bind xK_bracketleft $ noMod $
+ doc "Move forward in location history" navigateHistory
+ bind xK_bracketright $ noMod $
+ doc "Move backward in location history" navigateHistory
+
-- Double-tap Z to toggle zoom.
bind xK_z $ do
noMod -|- justMod $
@@ -723,8 +738,8 @@ mouseMap = runButtons $ do
(button4, increaseVolume),
(button5, decreaseVolume),
(button2, playPause),
- (button9, historyNext),
- (button8, historyPrev),
+ (button9, historyForward),
+ (button8, historyBack),
(button6, mediaPrev),
(button7, mediaNext)
]
@@ -743,7 +758,7 @@ mouseMap = runButtons $ do
]
forM_ (map fst swapButtons) $ \b ->
- bind b $ noMod $ \w -> click >> (continuous swapButtons b) w
+ bind b $ noMod $ \w -> click >> continuous swapButtons b w
bind button13 $ noMod $ subMouse $ do
bind button13 $ noMod $ subMouse $ do
@@ -757,10 +772,10 @@ mouseMap = runButtons $ do
bind button13 $
noMod $
noWindow $
- gotoWorkspace =<< (accompaningWorkspace <$> getCurrentWorkspace)
+ gotoWorkspace . accompaningWorkspace =<< getCurrentWorkspace
bind button15 $ do
- noMod $ noWindow jumpToLast
+ noMod $ noWindow jumpToLastLocation
let workspaceButtons = [
diff --git a/src/Rahm/Desktop/Layout.hs b/src/Rahm/Desktop/Layout.hs
index d8c3442..f6e714c 100644
--- a/src/Rahm/Desktop/Layout.hs
+++ b/src/Rahm/Desktop/Layout.hs
@@ -70,14 +70,14 @@ nLayouts = layoutListLength myLayoutList
-- "ForMosaic" is an instance of the Symbol kind. This is some neat type-system
-- hacking one can do in Haskell.
instance DoReinterpret "ForMosaic" where
-
+
-- IncMaster message
reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) = do
Just . SomeMessage <$> (
if n > 0
then expandPositionAlt
else shrinkPositionAlt)
-
+
-- ResizeMaster message
reinterpretMessage _ (fromMessage -> Just m) = do
Just . SomeMessage <$>
diff --git a/src/Rahm/Desktop/Layout/ConsistentMosaic.hs b/src/Rahm/Desktop/Layout/ConsistentMosaic.hs
index db1ce4e..a84a2f1 100644
--- a/src/Rahm/Desktop/Layout/ConsistentMosaic.hs
+++ b/src/Rahm/Desktop/Layout/ConsistentMosaic.hs
@@ -37,7 +37,7 @@ shrinkPositionAlt = doAlt shrinkWindowAlt
instance (LayoutClass l a, Show a, Ord a, Enum a, Num a) => LayoutClass (MosaicWrap l) a where
-
+
runLayout (W.Workspace t (MosaicWrap l) (id -> Just s)) rect = do
let zs = zipStack [100..] s
s' = mapStack fst zs
@@ -59,7 +59,7 @@ instance (LayoutClass l a, Show a, Ord a, Enum a, Num a) => LayoutClass (MosaicW
runLayout (W.Workspace t (MosaicWrap l) a) rect = do
(rects, maybeNewLayout) <- runLayout (W.Workspace t l a) rect
return (rects, MosaicWrap <$> maybeNewLayout)
-
+
-- By default just pass the message to the underlying layout.
handleMessage (MosaicWrap l) mess = do
diff --git a/src/Rahm/Desktop/Layout/Flip.hs b/src/Rahm/Desktop/Layout/Flip.hs
index e0d3abc..fe425e9 100644
--- a/src/Rahm/Desktop/Layout/Flip.hs
+++ b/src/Rahm/Desktop/Layout/Flip.hs
@@ -69,7 +69,7 @@ instance LayoutModifier Flip a where
Rectangle ((sx + fromIntegral sw) - x - fromIntegral w + sx) y w h
flipHoriz (Rectangle x y w h) =
Rectangle x ((sy + fromIntegral sh) - y - fromIntegral h + sy) w h
-
+
-- Handle DoFlip messages.
pureMess flip (fromMessage -> Just (DoFlip f)) = Just (f flip)
pureMess _ _ = Nothing
diff --git a/src/Rahm/Desktop/Layout/Hole.hs b/src/Rahm/Desktop/Layout/Hole.hs
index ee59726..3f7c9b7 100644
--- a/src/Rahm/Desktop/Layout/Hole.hs
+++ b/src/Rahm/Desktop/Layout/Hole.hs
@@ -32,11 +32,11 @@ instance (LayoutClass l a, Eq a, Num a) => LayoutClass (Hole l) a where
app x w | not enabled = w
app x (W.Workspace t l s) =
case s of
- Nothing ->
+ Nothing ->
W.Workspace t l (Just $ W.Stack x [] [])
Just (W.Stack h c e) ->
W.Workspace t l (Just $ W.Stack h c (e ++ [x]))
-
+
handleMessage h (fromMessage -> Just (ManageHole f)) =
return $ Just $ f h
handleMessage (Hole e l) a = do
diff --git a/src/Rahm/Desktop/Layout/List.hs b/src/Rahm/Desktop/Layout/List.hs
index f533ea2..77b53c9 100644
--- a/src/Rahm/Desktop/Layout/List.hs
+++ b/src/Rahm/Desktop/Layout/List.hs
@@ -102,7 +102,7 @@ instance (Selector t) => Selector (Sel t) where
increment (Skip l) = Skip <$> increment l
-- If the current element is selected, the increment is just the initial of
-- the tail.
- increment Sel = Skip <$> initial
+ increment Sel = Skip <$> initial
-- For a selection, the initial is just this in the Sel state.
initial = Just Sel
@@ -178,7 +178,7 @@ layoutListLengthProxy _ = Proxy
(|:) :: (LayoutSelect t a, LayoutClass l a) => l a -> t a -> LCons l t a
(|:) = LCons
-infixr 5 |:
+infixr 5 |:
-- Constructs a LayoutList. This function enforces that the SelectorFor l
-- is a 'Sel' type. Essentially this enforces that there must be at least one
diff --git a/src/Rahm/Desktop/Layout/Pop.hs b/src/Rahm/Desktop/Layout/Pop.hs
index 7e3dbd1..e06ff25 100644
--- a/src/Rahm/Desktop/Layout/Pop.hs
+++ b/src/Rahm/Desktop/Layout/Pop.hs
@@ -37,7 +37,7 @@ data PopMessage where
deriving (Message)
resizePop :: Float -> PopMessage
-resizePop f = PopMessage $ \(Poppable b x y l) ->
+resizePop f = PopMessage $ \(Poppable b x y l) ->
Poppable b (g $ x + f) (g $ y + f) l
where
g = max 0 . min 0.45
@@ -52,7 +52,7 @@ poppable :: l a -> Poppable l a
poppable = Poppable False 0.05 0.05
instance (LayoutClass l a, Eq a) => LayoutClass (Poppable l) a where
-
+
-- If the current layout is not popped, then just return what the underlying
-- layout returned.
diff --git a/src/Rahm/Desktop/Layout/Redescribe.hs b/src/Rahm/Desktop/Layout/Redescribe.hs
index c5c7472..036bc88 100644
--- a/src/Rahm/Desktop/Layout/Redescribe.hs
+++ b/src/Rahm/Desktop/Layout/Redescribe.hs
@@ -11,7 +11,7 @@ import Data.Typeable (Typeable)
-- Type-class to modify the description of a layout.
class Describer m l where
-
+
-- Returns the new description from the given description modifier, the layout
-- and the existing description.
newDescription :: m -> l a -> String -> String
diff --git a/src/Rahm/Desktop/Layout/ReinterpretMessage.hs b/src/Rahm/Desktop/Layout/ReinterpretMessage.hs
index 8f6a78d..e3434b1 100644
--- a/src/Rahm/Desktop/Layout/ReinterpretMessage.hs
+++ b/src/Rahm/Desktop/Layout/ReinterpretMessage.hs
@@ -31,7 +31,7 @@ data ReinterpretMessage k a = ReinterpretMessage
-- Instance for ReinterpretMessage as a Layout modifier.
instance (DoReinterpret k) =>
- LayoutModifier (ReinterpretMessage k) a where
+ LayoutModifier (ReinterpretMessage k) a where
handleMessOrMaybeModifyIt self message = do
diff --git a/src/Rahm/Desktop/Lib.hs b/src/Rahm/Desktop/Lib.hs
index 3b4ee9c..c7cfca4 100644
--- a/src/Rahm/Desktop/Lib.hs
+++ b/src/Rahm/Desktop/Lib.hs
@@ -48,14 +48,14 @@ getString = runQuery $ do
else printf "%s - %s" t a
askWindowId :: X (Maybe Window)
-askWindowId = pushHistory $ do
+askWindowId = do
windowTitlesToWinId <- withWindowSet $ \ss ->
Map.fromList <$> mapM (\wid -> (,) <$> getString wid <*> return wid) (allWindows ss)
runDMenuPromptWithMap "Window" (Just "#f542f5") windowTitlesToWinId
windowJump :: X ()
-windowJump = pushHistory $ do
+windowJump = do
windowId <- askWindowId
case windowId of
diff --git a/src/Rahm/Desktop/Marking.hs b/src/Rahm/Desktop/Marking.hs
index 98c96bb..b1783cc 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,86 +26,24 @@ 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 ->
-- return $ getLocationWorkspace =<< findWindow ss win
---
+--
-- mapM_ (windows . greedyView . tag) ws
-- focus win
@@ -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
diff --git a/src/Rahm/Desktop/Submap.hs b/src/Rahm/Desktop/Submap.hs
index da9fe77..5db8928 100644
--- a/src/Rahm/Desktop/Submap.hs
+++ b/src/Rahm/Desktop/Submap.hs
@@ -61,7 +61,7 @@ mapNextStringWithKeysym fn = do
ret <- io $ fix $ \nextkey -> do
ret <-
- getMaskEventWithTimeout 1000 d keyPressMask $ \p -> do
+ getMaskEventWithTimeout 2000 d keyPressMask $ \p -> do
KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p
keysym <- keycodeToKeysym d code 0
(_, str) <- lookupString (asKeyEvent p)
@@ -76,12 +76,12 @@ mapNextStringWithKeysym fn = do
Nothing -> return Nothing
io $ ungrabKeyboard d currentTime
- case ret of
+ case ret of
Just (m, str, keysym) -> fn m keysym str
Nothing -> return ()
{- Like submap, but on the character typed rather than the kysym. -}
-mapNextString :: (KeyMask -> String -> X ()) -> X ()
+mapNextString :: (KeyMask -> String -> X ()) -> X ()
mapNextString fn = mapNextStringWithKeysym (\m _ s -> fn m s)
submapDefaultWithKey :: ((KeyMask, KeySym) -> X ()) -> Map (KeyMask, KeySym) (X ()) -> X ()
diff --git a/src/Rahm/Desktop/Workspaces.hs b/src/Rahm/Desktop/Workspaces.hs
index 1349fea..de481ac 100644
--- a/src/Rahm/Desktop/Workspaces.hs
+++ b/src/Rahm/Desktop/Workspaces.hs
@@ -114,7 +114,7 @@ swapWorkspace toWorkspace = do
| otherwise = ws
adjacentWorkspaceNotVisible :: Selector -> WorkspaceId -> X WorkspaceId
-adjacentWorkspaceNotVisible (Selector selector) from =
+adjacentWorkspaceNotVisible (Selector selector) from =
withWindowSet $ \ss ->
let tags = sort $
W.tag . snd <$> filter (\x -> fst x /= Visible) (
@@ -123,7 +123,7 @@ adjacentWorkspaceNotVisible (Selector selector) from =
return $ fromMaybe from $ selector (==from) tags
adjacentWorkspace :: Selector -> WorkspaceId -> X WorkspaceId
-adjacentWorkspace (Selector selector) from =
+adjacentWorkspace (Selector selector) from =
withWindowSet $ \ss ->
let tags = sort $ W.tag . snd <$> getPopulatedWorkspaces ss
in
@@ -154,4 +154,4 @@ workspaceWithWindow wid = withWindowSet $ \(W.StackSet c v h _) ->
W.tag <$>
find (\(W.Workspace _ _ stack) -> wid `elem` W.integrate' stack)
(map W.workspace (c : v) ++ h)
-
+
diff --git a/src/Rahm/Desktop/XMobarLog.hs b/src/Rahm/Desktop/XMobarLog.hs
index 4f8bbb8..637670e 100644
--- a/src/Rahm/Desktop/XMobarLog.hs
+++ b/src/Rahm/Desktop/XMobarLog.hs
@@ -46,7 +46,7 @@ xMobarLogHook (XMobarLog xmproc) = do
hPutStrLn xmproc $ trunc 80 $ execWriter $ do
tell " "
tell layoutXpm
- tell $ "<fc=#404040> │ </fc>"
+ tell $ " "
forM_ wss $ \(t, ws) -> do
case t of
@@ -57,10 +57,10 @@ xMobarLogHook (XMobarLog xmproc) = do
tell $ toAction $ S.tag ws
tell " </fc></fn>"
- tell $ "<fc=#404040>│ </fc><fc=#a0a0a0><fn=3>"
+ tell $ " <fc=#a0a0a0><fn=3>"
tell $ title
tell $ "</fn></fc>"
-
+
where
toAction [ch] | (ch >= 'A' && ch <= 'Z') ||
(ch >= 'a' && ch <= 'z') ||