mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 11:30:22 -07:00
Merge pull request #766 from LSLeary/repeatable
Factor X.A.Cycle* modules; Write Alt+Tab style window switching
This commit is contained in:
Tony Zorman
GitHub
commit
a790c816d2
21
CHANGES.md
21
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,22 @@
|
||||
|
||||
### New Modules
|
||||
|
||||
* `XMonad.Actions.MostRecentlyUsed`
|
||||
|
||||
- Tab through windows by recency of use. Based on the Alt+Tab behaviour
|
||||
common outside of xmonad.
|
||||
|
||||
* `XMonad.Util.History`
|
||||
|
||||
- Track history in *O(log n)* time. Provides `History`, a variation on a
|
||||
LIFO stack with a uniqueness property. In order to achieve the desired
|
||||
asymptotics, the data type is implemented as an ordered Map.
|
||||
|
||||
* `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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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)
|
||||
|
||||
227
XMonad/Actions/MostRecentlyUsed.hs
Normal file
227
XMonad/Actions/MostRecentlyUsed.hs
Normal file
@ -0,0 +1,227 @@
|
||||
{-# LANGUAGE NamedFieldPuns, GeneralizedNewtypeDeriving #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Actions.MostRecentlyUsed
|
||||
-- Description : Tab through windows by recency of use.
|
||||
-- Copyright : (c) 2022 L. S. Leary
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : @LSLeary (on github)
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- Based on the Alt+Tab behaviour common outside of xmonad.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
-- --< Imports & Exports >-- {{{
|
||||
|
||||
module XMonad.Actions.MostRecentlyUsed (
|
||||
|
||||
-- * Usage
|
||||
-- $usage
|
||||
|
||||
-- * Interface
|
||||
configureMRU,
|
||||
mostRecentlyUsed,
|
||||
withMostRecentlyUsed,
|
||||
Location(..),
|
||||
|
||||
) where
|
||||
|
||||
-- base
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
|
||||
import Data.Monoid (All(..), Any)
|
||||
import Data.Foldable (for_)
|
||||
import Data.Functor (($>))
|
||||
import Data.IORef (newIORef, readIORef, writeIORef, modifyIORef)
|
||||
import Control.Applicative (liftA2)
|
||||
import Control.Monad (when, unless, join)
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
|
||||
-- mtl
|
||||
import Control.Monad.Trans (lift)
|
||||
import Control.Monad.State (get, put, gets)
|
||||
|
||||
-- containers
|
||||
import qualified Data.Map.Strict as M
|
||||
|
||||
-- xmonad
|
||||
import XMonad
|
||||
( Window, KeySym, keyPress, io
|
||||
, Event (DestroyWindowEvent, UnmapEvent, ev_send_event, ev_window)
|
||||
)
|
||||
import XMonad.Core
|
||||
( X, XConfig(..), windowset, WorkspaceId, ScreenId
|
||||
, ExtensionClass(..), StateExtension(..)
|
||||
, waitingUnmap
|
||||
)
|
||||
import XMonad.Operations (screenWorkspace)
|
||||
import qualified XMonad.StackSet as W
|
||||
|
||||
-- xmonad-contrib
|
||||
import qualified XMonad.Util.ExtensibleConf as XC
|
||||
import qualified XMonad.Util.ExtensibleState as XS
|
||||
import XMonad.Util.PureX
|
||||
(handlingRefresh, curScreenId, curTag, greedyView, view, peek, focusWindow)
|
||||
import XMonad.Util.History (History, origin, event, erase, ledger)
|
||||
import XMonad.Actions.Repeatable (repeatableSt)
|
||||
|
||||
-- }}}
|
||||
|
||||
-- --< Core Data Types: WindowHistory & Location >-- {{{
|
||||
|
||||
data WindowHistory = WinHist
|
||||
{ busy :: !Bool
|
||||
, hist :: !(History Window Location)
|
||||
} deriving (Show, Read)
|
||||
|
||||
instance ExtensionClass WindowHistory where
|
||||
initialValue = WinHist
|
||||
{ busy = False
|
||||
, hist = origin
|
||||
}
|
||||
extensionType = PersistentExtension
|
||||
|
||||
data Location = Location
|
||||
{ workspace :: !WorkspaceId
|
||||
, screen :: !ScreenId
|
||||
} deriving (Show, Read, Eq, Ord)
|
||||
|
||||
-- }}}
|
||||
|
||||
-- --< Interface >-- {{{
|
||||
|
||||
-- $usage
|
||||
--
|
||||
-- 'configureMRU' must be applied to your config in order for 'mostRecentlyUsed'
|
||||
-- to work.
|
||||
--
|
||||
-- > main :: IO ()
|
||||
-- > main = xmonad . configureMRU . ... $ def
|
||||
-- > { ...
|
||||
-- > }
|
||||
--
|
||||
-- Once that's done, it can be used normally in keybinds:
|
||||
--
|
||||
-- > , ((mod1Mask, xK_Tab), mostRecentlyUsed [xK_Alt_L, xK_Alt_R] xK_Tab)
|
||||
--
|
||||
-- N.B.: This example assumes that 'mod1Mask' corresponds to alt, which is not
|
||||
-- always the case, depending on how your system is configured.
|
||||
|
||||
-- | Configure xmonad to support 'mostRecentlyUsed'.
|
||||
configureMRU :: XConfig l -> XConfig l
|
||||
configureMRU = XC.once f (MRU ()) where
|
||||
f cnf = cnf
|
||||
{ logHook = logHook cnf <> logWinHist
|
||||
, handleEventHook = handleEventHook cnf <> winHistEH
|
||||
}
|
||||
newtype MRU = MRU () deriving Semigroup
|
||||
|
||||
-- | An action to browse through the history of focused windows, taking
|
||||
-- another step back with each tap of the key.
|
||||
mostRecentlyUsed
|
||||
:: [KeySym] -- ^ The 'KeySym's corresponding to the modifier to which the
|
||||
-- action is bound.
|
||||
-> KeySym -- ^ The 'KeySym' corresponding to the key to which the action
|
||||
-- is bound.
|
||||
-> X ()
|
||||
mostRecentlyUsed mods key = do
|
||||
(toUndo, undo) <- undoer
|
||||
let undoably curThing withThing thing = curThing >>= \cur ->
|
||||
when (cur /= thing) $ withThing thing >> toUndo (withThing cur)
|
||||
withMostRecentlyUsed mods key $ \win Location{workspace,screen} ->
|
||||
handlingRefresh $ do
|
||||
undo
|
||||
undoably curScreenId viewScreen screen
|
||||
undoably curTag greedyView workspace
|
||||
mi <- gets (W.findTag win . windowset)
|
||||
for_ mi $ \i -> do
|
||||
undoably curTag greedyView i
|
||||
mfw <- peek
|
||||
for_ mfw $ \fw -> do
|
||||
undoably (pure fw) focusWindow win
|
||||
where
|
||||
undoer :: (MonadIO m, Monoid a) => m (m a -> m (), m a)
|
||||
undoer = do
|
||||
ref <- io . newIORef $ pure mempty
|
||||
let toUndo = io . modifyIORef ref . liftA2 (<>)
|
||||
undo = join (io $ readIORef ref)
|
||||
<* io (writeIORef ref $ pure mempty)
|
||||
pure (toUndo, undo)
|
||||
viewScreen :: ScreenId -> X Any
|
||||
viewScreen scr = screenWorkspace scr >>= foldMap view
|
||||
|
||||
-- | A version of 'mostRecentlyUsed' that allows you to customise exactly what
|
||||
-- is done with each window you tab through (the default being to visit its
|
||||
-- previous 'Location' and give it focus).
|
||||
withMostRecentlyUsed
|
||||
:: [KeySym] -- ^ The 'KeySym's corresponding to the
|
||||
-- modifier to which the action is bound.
|
||||
-> KeySym -- ^ The 'KeySym' corresponding to the key to
|
||||
-- which the action is bound.
|
||||
-> (Window -> Location -> X ()) -- ^ The function applied to each window.
|
||||
-> X ()
|
||||
withMostRecentlyUsed mods tab preview = do
|
||||
wh@WinHist{busy,hist} <- XS.get
|
||||
unless busy $ do
|
||||
XS.put wh{ busy = True }
|
||||
|
||||
for_ (nonEmpty $ ledger hist) $ \ne -> do
|
||||
mfw <- gets (W.peek . windowset)
|
||||
let iSt = case cycleS ne of
|
||||
(w, _) :~ s | mfw == Just w -> s
|
||||
s -> s
|
||||
repeatableSt iSt mods tab $ \t s ->
|
||||
when (t == keyPress && s == tab) (pop >>= lift . uncurry preview)
|
||||
|
||||
XS.modify $ \ws@WinHist{} -> ws{ busy = False }
|
||||
logWinHist
|
||||
where
|
||||
pop = do
|
||||
h :~ t <- get
|
||||
put t $> h
|
||||
|
||||
-- }}}
|
||||
|
||||
-- --< Raw Config >-- {{{
|
||||
|
||||
logWinHist :: X ()
|
||||
logWinHist = do
|
||||
wh@WinHist{busy,hist} <- XS.get
|
||||
unless busy $ do
|
||||
cs <- gets (W.current . windowset)
|
||||
let cws = W.workspace cs
|
||||
for_ (W.stack cws) $ \st -> do
|
||||
let location = Location{ workspace = W.tag cws, screen = W.screen cs }
|
||||
XS.put wh{ hist = event (W.focus st) location hist }
|
||||
|
||||
winHistEH :: Event -> X All
|
||||
winHistEH ev = All True <$ case ev of
|
||||
UnmapEvent{ ev_send_event = synth, ev_window = w } -> do
|
||||
e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap)
|
||||
when (synth || e == 0) (collect w)
|
||||
DestroyWindowEvent{ ev_window = w } -> collect w
|
||||
_ -> pure ()
|
||||
where collect w = XS.modify $ \wh@WinHist{hist} -> wh{ hist = erase w hist }
|
||||
|
||||
-- }}}
|
||||
|
||||
-- --< Auxiliary Data Type: Stream >-- {{{
|
||||
|
||||
-- To satisfy the almighty exhaustivity checker.
|
||||
|
||||
data Stream a = !a :~ Stream a
|
||||
infixr 5 :~
|
||||
|
||||
(+~) :: [a] -> Stream a -> Stream a
|
||||
xs +~ s = foldr (:~) s xs
|
||||
infixr 5 +~
|
||||
|
||||
cycleS :: NonEmpty a -> Stream a
|
||||
cycleS (x :| xs) = s where s = x :~ xs +~ s
|
||||
|
||||
-- }}}
|
||||
|
||||
89
XMonad/Actions/Repeatable.hs
Normal file
89
XMonad/Actions/Repeatable.hs
Normal file
@ -0,0 +1,89 @@
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- 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", "XMonad.Actions.CycleWindows" and
|
||||
-- "XMonad.Actions.MostRecentlyUsed".
|
||||
--
|
||||
-- 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)
|
||||
128
XMonad/Util/History.hs
Normal file
128
XMonad/Util/History.hs
Normal file
@ -0,0 +1,128 @@
|
||||
{-# LANGUAGE NamedFieldPuns, DeriveTraversable #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Util.History
|
||||
-- Description : Track history in /O(log n)/ time.
|
||||
-- Copyright : (c) 2022 L. S. Leary
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : @LSLeary (on github)
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- Provides 'History', a variation on a LIFO stack with a uniqueness property.
|
||||
-- In order to achieve the desired asymptotics, the data type is implemented as
|
||||
-- an ordered Map.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Util.History (
|
||||
History,
|
||||
origin,
|
||||
event,
|
||||
erase,
|
||||
recall,
|
||||
ledger,
|
||||
transcribe,
|
||||
) where
|
||||
|
||||
-- base
|
||||
import Data.Function (on)
|
||||
import Text.Read
|
||||
( Read(readPrec, readListPrec), Lexeme(Ident)
|
||||
, parens, prec, lexP, step, readListPrecDefault
|
||||
)
|
||||
|
||||
-- containers
|
||||
import Data.IntMap (IntMap)
|
||||
import qualified Data.IntMap.Strict as I
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map.Strict as M
|
||||
|
||||
|
||||
-- | A history of unique @k@-events with @a@-annotations.
|
||||
--
|
||||
-- @History k a@ can be considered a (LIFO) stack of @(k, a)@ values with the
|
||||
-- property that each @k@ is unique. From this point of view, 'event' pushes
|
||||
-- and 'ledger' pops/peeks all.
|
||||
--
|
||||
-- The naive implementation has /O(n)/ 'event' and 'erase' due to the
|
||||
-- uniqueness condition, but we can still use it as a denotation:
|
||||
--
|
||||
-- > mu :: History k a -> [(k, a)]
|
||||
--
|
||||
-- As an opaque data type with strict operations, @History k a@ values are all
|
||||
-- finite expressions in the core interface: 'origin', 'erase' and 'event'.
|
||||
-- Hence we define @mu@ by structural induction on these three cases.
|
||||
--
|
||||
data History k a = History
|
||||
{ annals :: !(IntMap (k, a))
|
||||
, recorded :: !(Map k Int)
|
||||
} deriving (Functor, Foldable, Traversable)
|
||||
|
||||
instance (Eq k, Eq a) => Eq (History k a) where (==) = (==) `on` ledger
|
||||
instance (Ord k, Ord a) => Ord (History k a) where compare = compare `on` ledger
|
||||
|
||||
instance (Show k, Show a) => Show (History k a) where
|
||||
showsPrec d h
|
||||
= showParen (d > app_prec)
|
||||
$ showString "transcribe "
|
||||
. showsPrec (app_prec+1) (ledger h)
|
||||
where app_prec = 10
|
||||
|
||||
instance (Read k, Read a, Ord k) => Read (History k a) where
|
||||
readPrec = parens . prec app_prec $ do
|
||||
Ident "transcribe" <- lexP
|
||||
l <- step readPrec
|
||||
pure (transcribe l)
|
||||
where app_prec = 10
|
||||
readListPrec = readListPrecDefault
|
||||
|
||||
|
||||
-- | /O(1)/. A history of nothing.
|
||||
--
|
||||
-- > mu origin := []
|
||||
--
|
||||
origin :: History k a
|
||||
origin = History I.empty M.empty
|
||||
|
||||
-- | /O(log n)/. A new event makes history; its predecessor forgotten.
|
||||
--
|
||||
-- > mu (event k a h) := (k, a) : mu (erase k h)
|
||||
--
|
||||
event :: Ord k => k -> a -> History k a -> History k a
|
||||
event k a History{annals,recorded} = History
|
||||
{ annals = I.insert ik (k, a) . maybe id I.delete mseen $ annals
|
||||
, recorded = recorded'
|
||||
}
|
||||
where
|
||||
ik = maybe 0 (\((i, _), _) -> pred i) (I.minViewWithKey annals)
|
||||
(mseen, recorded') = M.insertLookupWithKey (\_ x _ -> x) k ik recorded
|
||||
|
||||
-- | /O(log n)/. Erase an event from history.
|
||||
--
|
||||
-- > mu (erase k h) := filter ((k /=) . fst) (mu h)
|
||||
--
|
||||
erase :: Ord k => k -> History k a -> History k a
|
||||
erase k History{annals,recorded} = History
|
||||
{ annals = maybe id I.delete mseen annals
|
||||
, recorded = recorded'
|
||||
}
|
||||
where (mseen, recorded') = M.updateLookupWithKey (\_ _ -> Nothing) k recorded
|
||||
|
||||
|
||||
-- | /O(log n)/. Recall an event.
|
||||
recall :: Ord k => k -> History k a -> Maybe a
|
||||
recall k History{annals,recorded} = do
|
||||
ik <- M.lookup k recorded
|
||||
(_, a) <- I.lookup ik annals
|
||||
pure a
|
||||
|
||||
-- | /O(n)/. Read history, starting with the modern day. @ledger@ is @mu@.
|
||||
ledger :: History k a -> [(k, a)]
|
||||
ledger = I.elems . annals
|
||||
|
||||
-- | /O(n * log n)/. Transcribe a ledger.
|
||||
transcribe :: Ord k => [(k, a)] -> History k a
|
||||
transcribe = foldr (uncurry event) origin
|
||||
@ -118,6 +118,7 @@ library
|
||||
XMonad.Actions.LinkWorkspaces
|
||||
XMonad.Actions.MessageFeedback
|
||||
XMonad.Actions.Minimize
|
||||
XMonad.Actions.MostRecentlyUsed
|
||||
XMonad.Actions.MouseGestures
|
||||
XMonad.Actions.MouseResize
|
||||
XMonad.Actions.Navigation2D
|
||||
@ -132,6 +133,7 @@ library
|
||||
XMonad.Actions.Promote
|
||||
XMonad.Actions.RandomBackground
|
||||
XMonad.Actions.RepeatAction
|
||||
XMonad.Actions.Repeatable
|
||||
XMonad.Actions.RotSlaves
|
||||
XMonad.Actions.RotateSome
|
||||
XMonad.Actions.Search
|
||||
@ -360,6 +362,7 @@ library
|
||||
XMonad.Util.Font
|
||||
XMonad.Util.Grab
|
||||
XMonad.Util.Hacks
|
||||
XMonad.Util.History
|
||||
XMonad.Util.Image
|
||||
XMonad.Util.Invisible
|
||||
XMonad.Util.Loggers
|
||||
@ -415,6 +418,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
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user