From 588e87efb099927fda713380e5bf64e8c7f1fdcd Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Fri, 15 Apr 2022 01:14:50 -0600 Subject: [WIP] - Window change hooks --- src/Rahm/Desktop/History.hs | 25 +++++++++++++++++++ src/Rahm/Desktop/Hooks/WindowChange.hs | 45 ++++++++++++++++++++++++++++++++++ 2 files changed, 70 insertions(+) create mode 100644 src/Rahm/Desktop/History.hs create mode 100644 src/Rahm/Desktop/Hooks/WindowChange.hs (limited to 'src') diff --git a/src/Rahm/Desktop/History.hs b/src/Rahm/Desktop/History.hs new file mode 100644 index 0000000..8aff845 --- /dev/null +++ b/src/Rahm/Desktop/History.hs @@ -0,0 +1,25 @@ +module Rahm.Desktop.History where + +import Data.IntMap (IntMap) +import qualified Data.IntMap as IntMap +import Data.Default + +import Rahm.Desktop.Hooks.WindowChange + +data History = History { + currentIndex :: Int + , history :: IntMap Location + } + +instance Default History where + def = History 0 IntMap.empty + +addToHistory :: Location -> History -> History +addToHistory loc (History currentIndex hist) = + let hist' = if currentIndex > 100 + then IntMap.delete (currentIndex - 100) hist + else hist + in History (currentIndex + 1 ) (IntMap.insert currentIndex loc hist) + +historyHook :: Location -> Location -> X () +historyHook = undefined 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 () + } -- cgit From 7a5051f7955a8b4e69b2c28b5a9b34f9730e21f0 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Fri, 15 Apr 2022 23:55:35 -0600 Subject: 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. --- src/Main.hs | 11 +++- src/Rahm/Desktop/History.hs | 91 +++++++++++++++++++++++++++----- src/Rahm/Desktop/Keys.hs | 39 +++++++++----- src/Rahm/Desktop/Lib.hs | 4 +- src/Rahm/Desktop/Marking.hs | 124 ++------------------------------------------ src/Rahm/Desktop/Submap.hs | 2 +- 6 files changed, 122 insertions(+), 149 deletions(-) (limited to 'src') 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 index 8aff845..dfecc63 100644 --- a/src/Rahm/Desktop/History.hs +++ b/src/Rahm/Desktop/History.hs @@ -1,25 +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 History = History { - currentIndex :: Int - , history :: IntMap Location - } +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 _ = "" + +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 0 IntMap.empty + def = History (BoundedSeqZipper 1000 mempty mempty) -addToHistory :: Location -> History -> History -addToHistory loc (History currentIndex hist) = - let hist' = if currentIndex > 100 - then IntMap.delete (currentIndex - 100) hist - else hist - in History (currentIndex + 1 ) (IntMap.insert currentIndex loc hist) +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 = undefined +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/Keys.hs b/src/Rahm/Desktop/Keys.hs index d302b59..ebc8b7f 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 () @@ -315,7 +316,7 @@ 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 -> @@ -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 $ @@ -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,18 @@ 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 navigateHistory + bind xK_bracketright $ noMod navigateHistory + -- Double-tap Z to toggle zoom. bind xK_z $ do noMod -|- justMod $ @@ -723,8 +736,8 @@ mouseMap = runButtons $ do (button4, increaseVolume), (button5, decreaseVolume), (button2, playPause), - (button9, historyNext), - (button8, historyPrev), + (button9, historyForward), + (button8, historyBack), (button6, mediaPrev), (button7, mediaNext) ] @@ -760,7 +773,7 @@ mouseMap = runButtons $ do gotoWorkspace =<< (accompaningWorkspace <$> getCurrentWorkspace) bind button15 $ do - noMod $ noWindow jumpToLast + noMod $ noWindow jumpToLastLocation let workspaceButtons = [ 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..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 diff --git a/src/Rahm/Desktop/Submap.hs b/src/Rahm/Desktop/Submap.hs index da9fe77..ad245ab 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) -- cgit From d1a00e6e42b4b513f7de66a9e710f62faca2ef00 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Sat, 16 Apr 2022 00:20:03 -0600 Subject: fix some hlint warnings --- src/Rahm/Desktop/History.hs | 2 +- src/Rahm/Desktop/Keys.hs | 16 +++++++++------- src/Rahm/Desktop/Layout.hs | 4 ++-- src/Rahm/Desktop/Layout/ConsistentMosaic.hs | 4 ++-- src/Rahm/Desktop/Layout/Flip.hs | 2 +- src/Rahm/Desktop/Layout/Hole.hs | 4 ++-- src/Rahm/Desktop/Layout/List.hs | 4 ++-- src/Rahm/Desktop/Layout/Pop.hs | 4 ++-- src/Rahm/Desktop/Layout/Redescribe.hs | 2 +- src/Rahm/Desktop/Layout/ReinterpretMessage.hs | 2 +- src/Rahm/Desktop/Marking.hs | 4 ++-- src/Rahm/Desktop/Submap.hs | 4 ++-- src/Rahm/Desktop/Workspaces.hs | 6 +++--- src/Rahm/Desktop/XMobarLog.hs | 2 +- 14 files changed, 31 insertions(+), 29 deletions(-) (limited to 'src') diff --git a/src/Rahm/Desktop/History.hs b/src/Rahm/Desktop/History.hs index dfecc63..5e15fe6 100644 --- a/src/Rahm/Desktop/History.hs +++ b/src/Rahm/Desktop/History.hs @@ -79,7 +79,7 @@ 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 diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index ebc8b7f..3e660b5 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -292,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\ @@ -319,7 +319,7 @@ keymap = runKeys $ do (_, 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 ()) @@ -456,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 @@ -616,8 +616,10 @@ keymap = runKeys $ do noMod $ doc "Move backward in location history" historyBack - bind xK_bracketleft $ noMod navigateHistory - bind xK_bracketright $ noMod navigateHistory + 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 @@ -756,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 @@ -770,7 +772,7 @@ mouseMap = runButtons $ do bind button13 $ noMod $ noWindow $ - gotoWorkspace =<< (accompaningWorkspace <$> getCurrentWorkspace) + gotoWorkspace . accompaningWorkspace =<< getCurrentWorkspace bind button15 $ do noMod $ noWindow jumpToLastLocation 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/Marking.hs b/src/Rahm/Desktop/Marking.hs index 639aae2..b1783cc 100644 --- a/src/Rahm/Desktop/Marking.hs +++ b/src/Rahm/Desktop/Marking.hs @@ -1,6 +1,6 @@ module Rahm.Desktop.Marking ( markCurrentWindow, - jumpToMark, + jumpToMark, swapWithMark, markToWindow ) where @@ -43,7 +43,7 @@ withMaybeFocused f = withWindowSet $ f . peek -- greedyFocus win = do -- ws <- withWindowSet $ \ss -> -- return $ getLocationWorkspace =<< findWindow ss win --- +-- -- mapM_ (windows . greedyView . tag) ws -- focus win diff --git a/src/Rahm/Desktop/Submap.hs b/src/Rahm/Desktop/Submap.hs index ad245ab..5db8928 100644 --- a/src/Rahm/Desktop/Submap.hs +++ b/src/Rahm/Desktop/Submap.hs @@ -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..f2cccf8 100644 --- a/src/Rahm/Desktop/XMobarLog.hs +++ b/src/Rahm/Desktop/XMobarLog.hs @@ -60,7 +60,7 @@ xMobarLogHook (XMobarLog xmproc) = do tell $ "" tell $ title tell $ "" - + where toAction [ch] | (ch >= 'A' && ch <= 'Z') || (ch >= 'a' && ch <= 'z') || -- cgit From 65456557536f7886ae079fa2b980a1ef7f0619c0 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Sat, 16 Apr 2022 00:54:01 -0600 Subject: Remove the "│" from xmobar. I think it makes it cleaner, but it is not a slam dunk. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Rahm/Desktop/XMobarLog.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/src/Rahm/Desktop/XMobarLog.hs b/src/Rahm/Desktop/XMobarLog.hs index f2cccf8..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 $ " │ " + tell $ " " forM_ wss $ \(t, ws) -> do case t of @@ -57,7 +57,7 @@ xMobarLogHook (XMobarLog xmproc) = do tell $ toAction $ S.tag ws tell " " - tell $ "" + tell $ " " tell $ title tell $ "" -- cgit