xmonad-contrib/XMonad/Util/ExclusiveScratchpads.hs
Tony Zorman b1b3c4c469 ~/.xmonad/xmonad.hs -> xmonad.hs
With XDG support so firmly ingrained now, it's about time we stop
hard-coding the configuration path in the docs.
2023-12-22 18:17:17 +01:00

267 lines
11 KiB
Haskell

{-# LANGUAGE LambdaCase #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Util.ExclusiveScratchpads
-- Description : Named scratchpads that can be mutually exclusive.
-- 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
{-# DEPRECATED "Use the exclusive scratchpad functionality of \"XMonad.Util.NamedScratchpad\" insead." #-}
(
-- * Usage
-- $usage
mkXScratchpads,
xScratchpadsManageHook,
-- * Keyboard related
scratchpadAction,
hideAll,
resetExclusiveSp,
-- * Mouse related
setNoexclusive,
resizeNoexclusive,
floatMoveNoexclusive,
-- * Types
ExclusiveScratchpad(..),
ExclusiveScratchpads,
-- * Hooks
nonFloating,
defaultFloating,
customFloating
) where
import XMonad.Prelude
import XMonad
import XMonad.Actions.Minimize
import XMonad.Actions.TagWindows (addTag,delTag)
import XMonad.Hooks.ManageHelpers (doRectFloat,isInProperty)
import qualified XMonad.StackSet as W
import qualified Data.List.NonEmpty as NE
-- $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.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" or
-- <https://xmonad.org/TUTORIAL.html#final-touches the tutorial>); e.g.,
--
-- > manageHook = myManageHook <> xScratchpadsManageHook scratchpads
--
-- And finally add some keybindings (see <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>):
--
-- > , ((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 <- NE.head . notEmpty . map hook <$> ys -- ys /= [], so `head` is fine
n <- NE.head . notEmpty . 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