mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 03:20:21 -07:00
264 lines
11 KiB
Haskell
264 lines
11 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
|
|
-----------------------------------------------------------------------------
|
|
-- |
|
|
-- Module : XMonad.Util.ExclusiveScratchpads
|
|
-- Copyright : Bruce Forte (2017)
|
|
-- License : BSD-style (see LICENSE)
|
|
--
|
|
-- Maintainer : Bruce Forte
|
|
-- Stability : unstable
|
|
-- Portability : unportable
|
|
--
|
|
-- Named scratchpads that can be mutually exclusive.
|
|
--
|
|
-----------------------------------------------------------------------------
|
|
|
|
module XMonad.Util.ExclusiveScratchpads (
|
|
-- * Usage
|
|
-- $usage
|
|
mkXScratchpads,
|
|
xScratchpadsManageHook,
|
|
-- * Keyboard related
|
|
scratchpadAction,
|
|
hideAll,
|
|
resetExclusiveSp,
|
|
-- * Mouse related
|
|
setNoexclusive,
|
|
resizeNoexclusive,
|
|
floatMoveNoexclusive,
|
|
-- * Types
|
|
ExclusiveScratchpad(..),
|
|
ExclusiveScratchpads,
|
|
-- * Hooks
|
|
nonFloating,
|
|
defaultFloating,
|
|
customFloating
|
|
) where
|
|
|
|
import Control.Applicative (liftA2)
|
|
import Control.Monad ((<=<),filterM,liftM2)
|
|
import Data.Monoid (appEndo)
|
|
import XMonad
|
|
import XMonad.Actions.Minimize
|
|
import XMonad.Actions.TagWindows (addTag,delTag)
|
|
import XMonad.Hooks.ManageHelpers (doRectFloat,isInProperty)
|
|
|
|
import qualified XMonad.StackSet as W
|
|
|
|
-- $usage
|
|
--
|
|
-- For this module to work properly, you need to use "XMonad.Layout.BoringWindows" and
|
|
-- "XMonad.Layout.Minimize", please refer to the documentation of these modules for more
|
|
-- information on how to configure them.
|
|
--
|
|
-- To use this module, put the following in your @~\/.xmonad\/xmonad.hs@:
|
|
--
|
|
-- > import XMonad.Utils.ExclusiveScratchpads
|
|
-- > import XMonad.ManageHook (title,appName)
|
|
-- > import qualified XMonad.StackSet as W
|
|
--
|
|
-- Add exclusive scratchpads, for example:
|
|
--
|
|
-- > exclusiveSps = mkXScratchpads [ ("htop", "urxvt -name htop -e htop", title =? "htop")
|
|
-- > , ("xclock", "xclock", appName =? "xclock")
|
|
-- > ] $ customFloating $ W.RationalRect (1/4) (1/4) (1/2) (1/2)
|
|
--
|
|
-- The scratchpads don\'t have to be exclusive, you can create them like this (see 'ExclusiveScratchpad'):
|
|
--
|
|
-- > regularSps = [ XSP "term" "urxvt -name scratchpad" (appName =? "scratchpad") defaultFloating [] ]
|
|
--
|
|
-- Create a list that contains all your scratchpads like this:
|
|
--
|
|
-- > scratchpads = exclusiveSps ++ regularSps
|
|
--
|
|
-- Add the hooks to your managehook (see "XMonad.Doc.Extending#Editing_the_manage_hook"), eg.:
|
|
--
|
|
-- > manageHook = myManageHook <+> xScratchpadsManageHook scratchpads
|
|
--
|
|
-- And finally add some keybindings (see "XMonad.Doc.Extending#Editing_key_bindings"):
|
|
--
|
|
-- > , ((modMask, xK_h), scratchpadAction scratchpads "htop")
|
|
-- > , ((modMask, xK_c), scratchpadAction scratchpads "xclock")
|
|
-- > , ((modMask, xK_t), scratchpadAction scratchpads "term")
|
|
-- > , ((modMask, xK_h), hideAll scratchpads)
|
|
--
|
|
-- Now you can get your scratchpads by pressing the corresponding keys, if you
|
|
-- have the @htop@ scratchpad on your current screen and you fetch the @xclock@
|
|
-- scratchpad then @htop@ gets hidden.
|
|
--
|
|
-- If you move a scratchpad it still gets hidden when you fetch a scratchpad of
|
|
-- the same family, to change that behaviour and make windows not exclusive
|
|
-- anymore when they get resized or moved add these mouse bindings
|
|
-- (see "XMonad.Doc.Extending#Editing_mouse_bindings"):
|
|
--
|
|
-- > , ((mod4Mask, button1), floatMoveNoexclusive scratchpads)
|
|
-- > , ((mod4Mask, button3), resizeNoexclusive scratchpads)
|
|
--
|
|
-- To reset a moved scratchpad to the original position that you set with its hook,
|
|
-- call @resetExclusiveSp@ when it is in focus. For example if you want to extend
|
|
-- Mod-Return to reset the placement when a scratchpad is in focus but keep the
|
|
-- default behaviour for tiled windows, set these key bindings:
|
|
--
|
|
-- > , ((modMask, xK_Return), windows W.swapMaster >> resetExclusiveSp scratchpads)
|
|
--
|
|
-- __Note:__ This is just an example, in general you can add more than two
|
|
-- exclusive scratchpads and multiple families of such.
|
|
|
|
data ExclusiveScratchpad = XSP { name :: String -- ^ Name of the scratchpad
|
|
, cmd :: String -- ^ Command to spawn the scratchpad
|
|
, query :: Query Bool -- ^ Query to match the scratchpad
|
|
, hook :: ManageHook -- ^ Hook to specify the placement policy
|
|
, exclusive :: [String] -- ^ Names of exclusive scratchpads
|
|
}
|
|
|
|
type ExclusiveScratchpads = [ExclusiveScratchpad]
|
|
|
|
-- -----------------------------------------------------------------------------------
|
|
|
|
-- | Create 'ExclusiveScratchpads' from @[(name,cmd,query)]@ with a common @hook@
|
|
mkXScratchpads :: [(String,String,Query Bool)] -- ^ List of @(name,cmd,query)@ of the
|
|
-- exclusive scratchpads
|
|
-> ManageHook -- ^ The common @hook@ that they use
|
|
-> ExclusiveScratchpads
|
|
mkXScratchpads xs h = foldl accumulate [] xs
|
|
where
|
|
accumulate a (n,c,q) = XSP n c q h (filter (n/=) names) : a
|
|
names = map (\(n,_,_) -> n) xs
|
|
|
|
-- | Create 'ManageHook' from 'ExclusiveScratchpads'
|
|
xScratchpadsManageHook :: ExclusiveScratchpads -- ^ List of exclusive scratchpads from
|
|
-- which a 'ManageHook' should be generated
|
|
-> ManageHook
|
|
xScratchpadsManageHook = composeAll . fmap (\sp -> query sp --> hook sp)
|
|
|
|
-- | Pop up/hide the scratchpad by name and possibly hide its exclusive
|
|
scratchpadAction :: ExclusiveScratchpads -- ^ List of exclusive scratchpads
|
|
-> String -- ^ Name of the scratchpad to toggle
|
|
-> X ()
|
|
scratchpadAction xs n =
|
|
let ys = filter ((n==).name) xs in
|
|
|
|
case ys of [] -> return ()
|
|
(sp:_) -> let q = query sp in withWindowSet $ \s -> do
|
|
ws <- filterM (runQuery q) $ W.allWindows s
|
|
|
|
case ws of [] -> do spawn (cmd sp)
|
|
hideOthers xs n
|
|
windows W.shiftMaster
|
|
|
|
(w:_) -> do toggleWindow w
|
|
whenX (runQuery isExclusive w) (hideOthers xs n)
|
|
where
|
|
toggleWindow w = liftA2 (&&) (runQuery isMaximized w) (onCurrentScreen w) >>= \case
|
|
True -> whenX (onCurrentScreen w) (minimizeWindow w)
|
|
False -> do windows (flip W.shiftWin w =<< W.currentTag)
|
|
maximizeWindowAndFocus w
|
|
windows W.shiftMaster
|
|
|
|
onCurrentScreen w = withWindowSet (return . elem w . currentWindows)
|
|
|
|
-- | Hide all 'ExclusiveScratchpads' on the current screen
|
|
hideAll :: ExclusiveScratchpads -- ^ List of exclusive scratchpads
|
|
-> X ()
|
|
hideAll xs = mapWithCurrentScreen q minimizeWindow
|
|
where q = joinQueries (map query xs) <&&> isExclusive <&&> isMaximized
|
|
|
|
-- | If the focused window is a scratchpad, the scratchpad gets reset to the original
|
|
-- placement specified with the hook and becomes exclusive again
|
|
resetExclusiveSp :: ExclusiveScratchpads -- ^ List of exclusive scratchpads
|
|
-> X ()
|
|
resetExclusiveSp xs = withFocused $ \w -> whenX (isScratchpad xs w) $ do
|
|
let ys = filterM (flip runQuery w . query) xs
|
|
|
|
unlessX (null <$> ys) $ do
|
|
mh <- (head . map hook) <$> ys -- ys /= [], so `head` is fine
|
|
n <- (head . map name) <$> ys -- same
|
|
|
|
(windows . appEndo <=< runQuery mh) w
|
|
hideOthers xs n
|
|
delTag "_XSP_NOEXCLUSIVE" w
|
|
|
|
where unlessX = whenX . fmap not
|
|
|
|
-- -----------------------------------------------------------------------------------
|
|
|
|
-- | Hide the scratchpad of the same family by name if it's on the focused workspace
|
|
hideOthers :: ExclusiveScratchpads -> String -> X ()
|
|
hideOthers xs n =
|
|
let ys = concatMap exclusive $ filter ((n==).name) xs
|
|
qs = map query $ filter ((`elem` ys).name) xs
|
|
q = joinQueries qs <&&> isExclusive <&&> isMaximized in
|
|
|
|
mapWithCurrentScreen q minimizeWindow
|
|
|
|
-- | Conditionally map a function on all windows of the current screen
|
|
mapWithCurrentScreen :: Query Bool -> (Window -> X ()) -> X ()
|
|
mapWithCurrentScreen q f = withWindowSet $ \s -> do
|
|
ws <- filterM (runQuery q) $ currentWindows s
|
|
mapM_ f ws
|
|
|
|
-- | Extract all windows on the current screen from a StackSet
|
|
currentWindows :: W.StackSet i l a sid sd -> [a]
|
|
currentWindows = W.integrate' . W.stack . W.workspace . W.current
|
|
|
|
-- | Check if given window is a scratchpad
|
|
isScratchpad :: ExclusiveScratchpads -> Window -> X Bool
|
|
isScratchpad xs w = withWindowSet $ \s -> do
|
|
let q = joinQueries $ map query xs
|
|
|
|
ws <- filterM (runQuery q) $ W.allWindows s
|
|
return $ elem w ws
|
|
|
|
-- | Build a disjunction from a list of clauses
|
|
joinQueries :: [Query Bool] -> Query Bool
|
|
joinQueries = foldl (<||>) (liftX $ return False)
|
|
|
|
-- | Useful queries
|
|
isExclusive, isMaximized :: Query Bool
|
|
isExclusive = (notElem "_XSP_NOEXCLUSIVE" . words) <$> stringProperty "_XMONAD_TAGS"
|
|
isMaximized = not <$> isInProperty "_NET_WM_STATE" "_NET_WM_STATE_HIDDEN"
|
|
|
|
-- -----------------------------------------------------------------------------------
|
|
|
|
-- | Make a window not exclusive anymore
|
|
setNoexclusive :: ExclusiveScratchpads -- ^ List of exclusive scratchpads
|
|
-> Window -- ^ Window which should be made not
|
|
-- exclusive anymore
|
|
-> X ()
|
|
setNoexclusive xs w = whenX (isScratchpad xs w) $ addTag "_XSP_NOEXCLUSIVE" w
|
|
|
|
-- | Float and drag the window, make it not exclusive anymore
|
|
floatMoveNoexclusive :: ExclusiveScratchpads -- ^ List of exclusive scratchpads
|
|
-> Window -- ^ Window which should be moved
|
|
-> X ()
|
|
floatMoveNoexclusive xs w = setNoexclusive xs w
|
|
>> focus w
|
|
>> mouseMoveWindow w
|
|
>> windows W.shiftMaster
|
|
|
|
-- | Resize window, make it not exclusive anymore
|
|
resizeNoexclusive :: ExclusiveScratchpads -- ^ List of exclusive scratchpads
|
|
-> Window -- ^ Window which should be resized
|
|
-> X ()
|
|
resizeNoexclusive xs w = setNoexclusive xs w
|
|
>> focus w
|
|
>> mouseResizeWindow w
|
|
>> windows W.shiftMaster
|
|
|
|
-- -----------------------------------------------------------------------------------
|
|
|
|
-- | Manage hook that makes the window non-floating
|
|
nonFloating :: ManageHook
|
|
nonFloating = idHook
|
|
|
|
-- | Manage hook that makes the window floating with the default placement
|
|
defaultFloating :: ManageHook
|
|
defaultFloating = doFloat
|
|
|
|
-- | Manage hook that makes the window floating with custom placement
|
|
customFloating :: W.RationalRect -- ^ @RationalRect x y w h@ that specifies relative position,
|
|
-- height and width (see "XMonad.StackSet#RationalRect")
|
|
-> ManageHook
|
|
customFloating = doRectFloat
|