forked from colonelpanic/dotfiles
[XMonad] Add class cycling
This commit is contained in:
parent
bffe020619
commit
5101d3f8a4
@ -26,6 +26,7 @@ executable imalison-xmonad
|
||||
bytestring>=0.10.8.1,
|
||||
containers>=0.5.7.1,
|
||||
directory>=1.2.6.2,
|
||||
filepath>=1.4.1.0
|
||||
filepath>=1.4.1.0,
|
||||
multimap>=1.2.1
|
||||
hs-source-dirs: .
|
||||
default-language: Haskell2010
|
||||
|
@ -9,6 +9,7 @@ import Data.Aeson
|
||||
import qualified Data.ByteString.Lazy as B
|
||||
import Data.List
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.MultiMap as MM
|
||||
import Data.Maybe
|
||||
import Graphics.X11.ExtraTypes.XF86
|
||||
import System.Directory
|
||||
@ -100,6 +101,9 @@ toggleInMap :: Ord k => k -> M.Map k Bool -> M.Map k Bool
|
||||
toggleInMap = toggleInMap' True
|
||||
|
||||
maybeRemap k = M.findWithDefault k k
|
||||
|
||||
(<$.>) :: Functor f => (b -> c) -> (a -> f b) -> a -> f c
|
||||
(<$.>) l r = fmap l . r
|
||||
|
||||
-- Selectors
|
||||
|
||||
@ -383,11 +387,38 @@ maybeUnminimizeAfter = (>> maybeUnminimizeFocused)
|
||||
|
||||
maybeUnminimizeClassAfter = (>> maximizeSameClassesInWorkspace)
|
||||
|
||||
sameClassOnly action =
|
||||
action >> minimizeOtherClassesInWorkspace >> maximizeSameClassesInWorkspace
|
||||
|
||||
restoreAllMinimized = restoreFocus $
|
||||
withLastMinimized $ \w -> maximizeWindow w >> restoreAllMinimized
|
||||
|
||||
restoreOrMinimizeOtherClasses = withLastMinimized' $
|
||||
maybe minimizeOtherClassesInWorkspace (`seq` restoreAllMinimized)
|
||||
|
||||
getClassPair w = flip (,) w <$> getClass w
|
||||
|
||||
windowClassPairs = withWindowSet $ mapM getClassPair . W.allWindows
|
||||
classToWindowMap = MM.fromList <$> windowClassPairs
|
||||
allClasses = sort . MM.keys <$> classToWindowMap
|
||||
thisClass = withWindowSet $ sequence . (getClass <$.> W.peek)
|
||||
|
||||
nextClass = do
|
||||
classes <- allClasses
|
||||
current <- thisClass
|
||||
let index = join $ elemIndex <$> current <*> pure classes
|
||||
return $ fmap (\i -> cycle classes !! (i + 1)) index
|
||||
|
||||
classWindow c = do
|
||||
m <- classToWindowMap
|
||||
return $ join $ listToMaybe <$> (flip MM.lookup m <$> c)
|
||||
|
||||
nextClassWindow = nextClass >>= classWindow
|
||||
|
||||
focusNextClass' = join $ windows . maybe id greedyFocusWindow <$> nextClassWindow
|
||||
focusNextClass = sameClassOnly focusNextClass'
|
||||
|
||||
selectClass = join $ DM.menuArgs "rofi" ["-dmenu", "-i"] <$> allClasses
|
||||
|
||||
-- Window switching
|
||||
|
||||
@ -438,8 +469,11 @@ myBringNextMaybe =
|
||||
|
||||
bindBringAndRaise :: KeyMask -> KeySym -> X () -> Query Bool -> [((KeyMask, KeySym), X ())]
|
||||
bindBringAndRaise mask sym start query =
|
||||
[ ((mask, sym), myRaiseNextMaybe start query)
|
||||
, ((mask .|. controlMask, sym), myBringNextMaybe start query)]
|
||||
[ ((mask, sym), doRaiseNext)
|
||||
, ((mask .|. controlMask, sym), myBringNextMaybe start query)
|
||||
, ((mask .|. shiftMask, sym), doRaiseNext >> minimizeOtherClassesInWorkspace)
|
||||
]
|
||||
where doRaiseNext = myRaiseNextMaybe start query
|
||||
|
||||
bindBringAndRaiseMany :: [(KeyMask, KeySym, X (), Query Bool)] -> [((KeyMask, KeySym), X())]
|
||||
bindBringAndRaiseMany = concatMap (\(a, b, c, d) -> bindBringAndRaise a b c d)
|
||||
@ -458,6 +492,8 @@ addKeys conf@XConfig {modMask = modm} =
|
||||
, ((modm .|. shiftMask, xK_p), spawn "rofi -show run")
|
||||
, ((modm, xK_g), andDeactivateFull . maybeUnminimizeAfter $
|
||||
actionMenu myWindowBringerConfig greedyFocusWindow)
|
||||
, ((modm .|. shiftMask, xK_g), andDeactivateFull . sameClassOnly $
|
||||
actionMenu myWindowBringerConfig greedyFocusWindow)
|
||||
, ((modm, xK_b), andDeactivateFull $ myBringWindow myWindowBringerConfig)
|
||||
, ((modm .|. shiftMask, xK_b),
|
||||
swapMinimizeStateAfter $ actionMenu myWindowBringerConfig swapFocusedWith)
|
||||
@ -478,6 +514,7 @@ addKeys conf@XConfig {modMask = modm} =
|
||||
, ((modm, xK_j), focusDown)
|
||||
, ((modm, xK_k), focusUp)
|
||||
, ((modm, xK_m), focusMaster)
|
||||
, ((modm, xK_Tab), focusNextClass)
|
||||
|
||||
-- Hyper bindings
|
||||
, ((mod3Mask, xK_1), toggleFadingForActiveWindow)
|
||||
|
Loading…
Reference in New Issue
Block a user