diff --git a/CHANGES.md b/CHANGES.md index d033aac6..94dbbe3d 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -11,6 +11,11 @@ - Deprecated the module in favour of the (new) exclusive scratchpad functionality of `XMonad.Util.NamedScratchpad`. + * `XMonad.Actions.CycleWorkspaceByScreen` + + - The type of `repeatableAction` has changed, and it's deprecated in + favour of `X.A.Repeatable.repeatable`. + * `XMonad.Hooks.DynamicProperty` - Deprecated the module in favour of the more aptly named @@ -72,6 +77,11 @@ ### New Modules + * `XMonad.Actions.Repeatable` + + - Actions you'd like to repeat. Factors out the shared logic of + `X.A.CycleRecentWS`, `X.A.CycleWorkspaceByScreen` and `X.A.CycleWindows`. + * `XMonad.Hooks.OnPropertyChange`: - A new module replicating the functionality of diff --git a/XMonad/Actions/CycleRecentWS.hs b/XMonad/Actions/CycleRecentWS.hs index ce8b0849..409e2b15 100644 --- a/XMonad/Actions/CycleRecentWS.hs +++ b/XMonad/Actions/CycleRecentWS.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE PatternGuards #-} +{-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.CycleRecentWS @@ -35,11 +36,15 @@ module XMonad.Actions.CycleRecentWS ( #endif ) where +import XMonad.Actions.Repeatable (repeatableSt) + import XMonad hiding (workspaces) -import XMonad.StackSet hiding (filter) +import XMonad.StackSet hiding (filter, modify) import Control.Arrow ((&&&)) import Data.Function (on) +import Data.Functor (void) +import Control.Monad.State (lift, when) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: @@ -111,25 +116,15 @@ cycleWindowSets :: (WindowSet -> [WorkspaceId]) -- ^ A function used to create a -> X () cycleWindowSets genOptions mods keyNext keyPrev = do (options, unView') <- gets $ (genOptions &&& unView) . windowset - XConf {theRoot = root, display = d} <- ask - let event = allocaXEvent $ \p -> do - maskEvent d (keyPressMask .|. keyReleaseMask) p - KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p - s <- keycodeToKeysym d c 0 - return (t, s) - let setOption n = do windows $ view (options `cycref` n) . unView' - (t, s) <- io event - case () of - () | t == keyPress && s == keyNext -> setOption (n+1) - | t == keyPress && s == keyPrev -> setOption (n-1) - | t == keyRelease && s `elem` mods -> return () - | otherwise -> setOption n - io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime - setOption 0 - io $ ungrabKeyboard d currentTime - where - cycref :: [a] -> Int -> a - cycref l i = l !! (i `mod` length l) + let + preview = do + i <- get + lift $ windows (view (options !! (i `mod` n)) . unView') + where n = length options + void . repeatableSt (-1) mods keyNext $ \t s -> when (t == keyPress) $ if + | s == keyNext -> modify succ >> preview + | s == keyPrev -> modify pred >> preview + | otherwise -> pure () -- | Given an old and a new 'WindowSet', which is __exactly__ one -- 'view' away from the old one, restore the workspace order of the diff --git a/XMonad/Actions/CycleWindows.hs b/XMonad/Actions/CycleWindows.hs index 90be24a0..1d647f21 100644 --- a/XMonad/Actions/CycleWindows.hs +++ b/XMonad/Actions/CycleWindows.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE ViewPatterns, MultiWayIf #-} -------------------------------------------------------------------------------- -- | @@ -59,8 +59,10 @@ import XMonad.Prelude import qualified XMonad.StackSet as W import qualified Data.List.NonEmpty as NE import XMonad.Actions.RotSlaves +import XMonad.Actions.Repeatable (repeatableSt) import Control.Arrow (second) +import Control.Monad.Trans (lift) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: @@ -139,27 +141,19 @@ cycleStacks' :: (W.Stack Window -> [W.Stack Window]) -- ^ A function to a finite -> KeySym -- ^ Key used to select a \"previous\" stack. -> X () cycleStacks' filteredPerms mods keyNext keyPrev = do - XConf {theRoot = root, display = d} <- ask - stacks <- gets $ maybe [] filteredPerms . W.stack . W.workspace . W.current . windowset - - let evt = allocaXEvent $ - \p -> do maskEvent d (keyPressMask .|. keyReleaseMask) p - KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p - s <- keycodeToKeysym d c 0 - return (t, s) - choose n (t, s) - | t == keyPress && s == keyNext = io evt >>= choose (n+1) - | t == keyPress && s == keyPrev = io evt >>= choose (n-1) - | t == keyPress && s `elem` [xK_0..xK_9] = io evt >>= choose (numKeyToN s) - | t == keyRelease && s `elem` mods = return () - | otherwise = doStack n >> io evt >>= choose n - doStack n = windows . W.modify' . const $ stacks `cycref` n - - io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime - io evt >>= choose 1 - io $ ungrabKeyboard d currentTime - where cycref l i = l !! (i `mod` length l) -- modify' ensures l is never [], but must also be finite - numKeyToN = subtract 48 . read . show + stacks <- gets $ maybe [] filteredPerms + . W.stack . W.workspace . W.current . windowset + let + preview = do + i <- get + lift . windows . W.modify' . const $ stacks !! (i `mod` n) + where n = length stacks + void $ repeatableSt 0 mods keyNext $ \t s -> if + | t == keyPress && s == keyNext -> modify succ + | t == keyPress && s == keyPrev -> modify pred + | t == keyPress && s `elem` [xK_0..xK_9] -> put (numKeyToN s) + | otherwise -> preview + where numKeyToN = subtract 48 . read . show -- | Given a stack element and a stack, shift or insert the element (window) -- at the currently focused position. diff --git a/XMonad/Actions/CycleWorkspaceByScreen.hs b/XMonad/Actions/CycleWorkspaceByScreen.hs index d1cd2efe..b77c4162 100644 --- a/XMonad/Actions/CycleWorkspaceByScreen.hs +++ b/XMonad/Actions/CycleWorkspaceByScreen.hs @@ -25,11 +25,10 @@ module XMonad.Actions.CycleWorkspaceByScreen ( import Data.IORef -import Graphics.X11.Xlib.Extras - import XMonad import XMonad.Prelude import XMonad.Hooks.WorkspaceHistory +import XMonad.Actions.Repeatable (repeatable) import qualified XMonad.StackSet as W -- $usage @@ -53,22 +52,9 @@ import qualified XMonad.StackSet as W -- -- > , ((mod4Mask, xK_slash), cycleWorkspaceOnCurrentScreen [xK_Super_L] xK_slash xK_p) -repeatableAction :: [KeySym] -> (EventType -> KeySym -> X ()) -> X () -repeatableAction mods pressHandler = do - XConf {theRoot = root, display = d} <- ask - let getNextEvent = io $ allocaXEvent $ \p -> - do - maskEvent d (keyPressMask .|. keyReleaseMask) p - KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p - s <- io $ keycodeToKeysym d c 0 - return (t, s) - handleEvent (t, s) - | t == keyRelease && s `elem` mods = return () - | otherwise = pressHandler t s >> getNextEvent >>= handleEvent - - io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime - getNextEvent >>= handleEvent - io $ ungrabKeyboard d currentTime +{-# DEPRECATED repeatableAction "Use XMonad.Actions.Repeatable.repeatable" #-} +repeatableAction :: [KeySym] -> KeySym -> (EventType -> KeySym -> X ()) -> X () +repeatableAction = repeatable handleKeyEvent :: EventType -> KeySym @@ -109,8 +95,7 @@ cycleWorkspaceOnScreen screenId mods nextKey prevKey = workspaceHistoryTransacti return $ cycleWorkspaces !! current focusIncrement i = io (getAndIncrementWS i) >>= (windows . W.greedyView) - focusIncrement 1 -- Do the first workspace cycle - repeatableAction mods $ + repeatable mods nextKey $ runFirst [ handleKeyEvent keyPress nextKey $ focusIncrement 1 , handleKeyEvent keyPress prevKey $ focusIncrement (-1) diff --git a/XMonad/Actions/Repeatable.hs b/XMonad/Actions/Repeatable.hs new file mode 100644 index 00000000..6f2a39e2 --- /dev/null +++ b/XMonad/Actions/Repeatable.hs @@ -0,0 +1,88 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.Repeatable +-- Description : Actions you'd like to repeat. +-- Copyright : (c) 2022 L. S. Leary +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : @LSLeary (on github) +-- Stability : unstable +-- Portability : unportable +-- +-- This module factors out the shared logic of "XMonad.Actions.CycleRecentWS", +-- "XMonad.Actions.CycleWorkspaceByScreen" and "XMonad.Actions.CycleWindows". +-- +-- See the source of these modules for usage examples. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.Repeatable + ( repeatable + , repeatableSt + , repeatableM + ) where + +-- mtl +import Control.Monad.State (StateT(..)) + +-- X11 +import Graphics.X11.Xlib.Extras + +-- xmonad +import XMonad + + +-- | An action that temporarily usurps and responds to key press/release events, +-- concluding when one of the modifier keys is released. +repeatable + :: [KeySym] -- ^ The list of 'KeySym's under the + -- modifiers used to invoke the action. + -> KeySym -- ^ The keypress that invokes the action. + -> (EventType -> KeySym -> X ()) -- ^ The keypress handler. + -> X () +repeatable = repeatableM id + +-- | A more general variant of 'repeatable' with a stateful handler, +-- accumulating a monoidal return value throughout the events. +repeatableSt + :: Monoid a + => s -- ^ Initial state. + -> [KeySym] -- ^ The list of 'KeySym's under the + -- modifiers used to invoke the + -- action. + -> KeySym -- ^ The keypress that invokes the + -- action. + -> (EventType -> KeySym -> StateT s X a) -- ^ The keypress handler. + -> X (a, s) +repeatableSt iSt = repeatableM $ \m -> runStateT m iSt + +-- | A more general variant of 'repeatable' with an arbitrary monadic handler, +-- accumulating a monoidal return value throughout the events. +repeatableM + :: (MonadIO m, Monoid a) + => (m a -> X b) -- ^ How to run the monad in 'X'. + -> [KeySym] -- ^ The list of 'KeySym's under the + -- modifiers used to invoke the action. + -> KeySym -- ^ The keypress that invokes the action. + -> (EventType -> KeySym -> m a) -- ^ The keypress handler. + -> X b +repeatableM run mods key pressHandler = do + XConf{ theRoot = root, display = d } <- ask + run (repeatableRaw d root mods key pressHandler) + +repeatableRaw + :: (MonadIO m, Monoid a) + => Display -> Window + -> [KeySym] -> KeySym -> (EventType -> KeySym -> m a) -> m a +repeatableRaw d root mods key pressHandler = do + io (grabKeyboard d root False grabModeAsync grabModeAsync currentTime) + handleEvent (keyPress, key) <* io (ungrabKeyboard d currentTime) + where + getNextEvent = io $ allocaXEvent $ \p -> do + maskEvent d (keyPressMask .|. keyReleaseMask) p + KeyEvent{ ev_event_type = t, ev_keycode = c } <- getEvent p + s <- keycodeToKeysym d c 0 + return (t, s) + handleEvent (t, s) + | t == keyRelease && s `elem` mods = pure mempty + | otherwise = (<>) <$> pressHandler t s <*> (getNextEvent >>= handleEvent) diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index ac7fb541..7d5da602 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -132,6 +132,7 @@ library XMonad.Actions.Promote XMonad.Actions.RandomBackground XMonad.Actions.RepeatAction + XMonad.Actions.Repeatable XMonad.Actions.RotSlaves XMonad.Actions.RotateSome XMonad.Actions.Search @@ -415,6 +416,7 @@ test-suite tests XMonad.Actions.FocusNth XMonad.Actions.GridSelect XMonad.Actions.PhysicalScreens + XMonad.Actions.Repeatable XMonad.Actions.RotateSome XMonad.Actions.Submap XMonad.Actions.SwapWorkspaces