twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-05-19 03:20:21 -07:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #543 from slotThe/view-ws-instead-of-entering-parallel-universe-where-the-focus-is-somewhere-else

Browse Source 
X.A.CycleRecentWS: Cycle workspaces, not windowsets
This commit is contained in:
slotThe 2021-06-02 09:42:09 +02:00 committed by GitHub
commit ff42434be3
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
5 changed files with 97 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
CHANGES.md
View File

@ -92,6 +92,15 @@
`tiActions`, `tiDirs`, `noAction`, and `inHome` for a more
convenient specification of topics.
* `XMonad.Actions.CycleRecentWS`
- Changed the signature of `recentWS` to return a `[WorkspaceId]`
instead of a `[WindowSet]`, while `cycleWindowSets` and
`toggleWindowSets` now take a function `WindowSet ->
[WorkspaceId]` instead of one to `[WindowSet]` as their first
argument. This fixes the interplay between this module and any
layout that stores state.
### New Modules
* `XMonad.Hooks.StatusBar.PP`

71
XMonad/Actions/CycleRecentWS.hs
View File

@ -1,3 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PatternGuards #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.CycleRecentWS
@ -24,12 +27,19 @@ module XMonad.Actions.CycleRecentWS (
toggleRecentWS,
toggleRecentNonEmptyWS,
toggleWindowSets,
recentWS
recentWS,
#ifdef TESTING
unView,
#endif
) where
import XMonad hiding (workspaces)
import XMonad.StackSet hiding (filter)
import Control.Arrow ((&&&))
import Data.Function (on)
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
--
@ -76,41 +86,37 @@ toggleRecentNonEmptyWS :: X ()
toggleRecentNonEmptyWS = toggleWindowSets $ recentWS (not . null . stack)
-- | Given a predicate p and the current WindowSet w, create a list of recent WindowSets,
-- most recent first, where the focused workspace satisfies p.
-- | Given a predicate @p@ and the current 'WindowSet' @w@, create a
-- list of workspaces to choose from. They are ordered by recency and
-- have to satisfy @p@.
recentWS :: (WindowSpace -> Bool) -- ^ A workspace predicate.
-> WindowSet -- ^ The current WindowSet
-> [WindowSet]
recentWS p w = map (`view` w) recentTags
where recentTags = map tag
-> [WorkspaceId]
recentWS p w = map tag
$ filter p
$ map workspace (visible w)
++ hidden w
++ [workspace (current w)]
cycref :: [a] -> Int -> a
cycref l i = l !! (i `mod` length l)
-- | Cycle through a finite list of WindowSets with repeated presses of a key, while
-- | Cycle through a finite list of workspaces with repeated presses of a key, while
-- a modifier key is held down. For best effects use the same modkey+key combination
-- as the one used to invoke this action.
cycleWindowSets :: (WindowSet -> [WindowSet]) -- ^ A function used to create a list of WindowSets to choose from
cycleWindowSets :: (WindowSet -> [WorkspaceId]) -- ^ A function used to create a list of workspaces to choose from
-> [KeySym] -- ^ A list of modifier keys used when invoking this action.
-- As soon as one of them is released, the final WindowSet is chosen and the action exits.
-> KeySym -- ^ Key used to preview next WindowSet from the list of generated options
-> KeySym -- ^ Key used to preview previous WindowSet from the list of generated options.
-- As soon as one of them is released, the final workspace is chosen and the action exits.
-> KeySym -- ^ Key used to preview next workspace from the list of generated options
-> KeySym -- ^ Key used to preview previous workspace from the list of generated options.
-- If it's the same as nextOption key, it is effectively ignored.
-> X ()
cycleWindowSets genOptions mods keyNext keyPrev = do
options <- gets $ genOptions . windowset
(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 $ const $ options `cycref` n
let setOption n = do windows $ view (options `cycref` n) . unView'
(t, s) <- io event
case () of
() | t == keyPress && s == keyNext -> setOption (n+1)
@ -120,12 +126,37 @@ cycleWindowSets genOptions mods keyNext keyPrev = do
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)
-- | Given an old and a new 'WindowSet', which is __exactly__ one
-- 'view' away from the old one, restore the workspace order of the
-- former inside of the latter. This respects any new state that the
-- new 'WindowSet' may have accumulated.
unView :: forall i l a s sd. (Eq i, Eq s)
=> StackSet i l a s sd -> StackSet i l a s sd -> StackSet i l a s sd
unView w0 w1 = fixOrderH . fixOrderV . view' (currentTag w0) $ w1
where
view' = if screen (current w0) == screen (current w1) then greedyView else view
fixOrderV w | v : vs <- visible w = w{ visible = insertAt (pfxV (visible w0) vs) v vs }
| otherwise = w
fixOrderH w | h : hs <- hidden w = w{ hidden = insertAt (pfxH (hidden w0) hs) h hs }
| otherwise = w
pfxV = commonPrefix `on` fmap (tag . workspace)
pfxH = commonPrefix `on` fmap tag
-- | Switch to the first of a finite list of WindowSets.
toggleWindowSets :: (WindowSet -> [WindowSet]) -> X ()
insertAt :: Int -> x -> [x] -> [x]
insertAt n x xs = let (l, r) = splitAt n xs in l ++ [x] ++ r
commonPrefix :: Eq x => [x] -> [x] -> Int
commonPrefix a b = length $ takeWhile id $ zipWith (==) a b
-- | Given some function that generates a list of workspaces from a
-- given 'WindowSet', switch to the first generated workspace.
toggleWindowSets :: (WindowSet -> [WorkspaceId]) -> X ()
toggleWindowSets genOptions = do
options <- gets $ genOptions . windowset
case options of
[] -> return ()
o:_ -> windows (const o)
o:_ -> windows (view o)

24
tests/CycleRecentWS.hs Normal file
View File

@ -0,0 +1,24 @@
{-# OPTIONS_GHC -Wall #-}
module CycleRecentWS where
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck
import XMonad.Actions.CycleRecentWS (unView)
import XMonad.StackSet (view, greedyView, mapLayout)
import Instances
import Utils (tags)
spec :: Spec
spec = do
prop "prop_unView" $ prop_unView
prop_unView :: T -> Property
prop_unView ss = conjoin
[ counterexample desc (unView ss (state (v t ss)) === state ss)
| t <- tags ss
, (desc, v) <- [("view " <> show t, view), ("greedyView " <> show t, greedyView)] ]
where
state = mapLayout succ

2
tests/Main.hs
View File

@ -10,6 +10,7 @@ import qualified RotateSome
import qualified Selective
import qualified SwapWorkspaces
import qualified XPrompt
import qualified CycleRecentWS
main :: IO ()
main = hspec $ do
@ -45,3 +46,4 @@ main = hspec $ do
prop "prop_skipGetLastWord" $ XPrompt.prop_skipGetLastWord
context "NoBorders" $ NoBorders.spec
context "ExtensibleConf" $ ExtensibleConf.spec
context "CycleRecentWS" $ CycleRecentWS.spec

8
xmonad-contrib.cabal
View File

@ -373,15 +373,16 @@ library
test-suite tests
type: exitcode-stdio-1.0
main-is: Main.hs
other-modules: ManageDocks
other-modules: CycleRecentWS
Instances
ManageDocks
NoBorders
RotateSome
Selective
SwapWorkspaces
XPrompt
Instances
Utils
ExtensibleConf
XMonad.Actions.CycleRecentWS
XMonad.Actions.CycleWS
XMonad.Actions.FocusNth
XMonad.Actions.PhysicalScreens
@ -409,6 +410,7 @@ test-suite tests
XMonad.Util.WorkspaceCompare
XMonad.Util.XSelection
XMonad.Util.XUtils
XPrompt
hs-source-dirs: tests, .
build-depends: base
, QuickCheck >= 2