Files
xmonad-contrib/XMonad/Util/ExclusiveScratchpads.hs
Tony Zorman 3d65a6bf72 Refer to the tutorial instead of X.D.Extending more often
Essentially, whenever the tutorial actually has decent material on the
subject matter.  The replacement is roughly done as follows:

  - logHook → tutorial
  - keybindings → tutorial, as this is thoroughly covered
  - manageHook → tutorial + X.D.Extending, as the manageHook stuff the
    tutorial talks about is a little bit of an afterthought.
  - X.D.Extending (on its own) → tutorial + X.D.Extending
  - layoutHook → tutorial + X.D.Extending, as the tutorial, while
    talking about layouts, doesn't necessarily have a huge focus there.
  - mouse bindings → leave this alone, as the tutorial does not at all
    talk about them.
2022-10-21 09:17:43 +02:00

264 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 (
-- * 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 (appEndo, filterM, liftA2, (<=<))
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" 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 <- 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