diff --git a/CHANGES.md b/CHANGES.md index 5d4534e0..b9df3753 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -28,6 +28,13 @@ is a problem when a different slave window is selected without changing the stack order. + * `XMonad.Util.ExclusiveScratchpads` + + Named scratchpads that can be mutually exclusive: This new module extends the + idea of named scratchpads such that you can define "families of scratchpads" + that are exclusive on the same screen. It also allows to remove this + constraint of being mutually exclusive with another scratchpad. + ### Bug Fixes and Minor Changes * `XMonad.Prompt` diff --git a/XMonad/Util/ExclusiveScratchpads.hs b/XMonad/Util/ExclusiveScratchpads.hs new file mode 100644 index 00000000..b734912f --- /dev/null +++ b/XMonad/Util/ExclusiveScratchpads.hs @@ -0,0 +1,263 @@ +{-# 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 ((<$>)) +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 = liftM2 (&&) (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 diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index 23dc0b22..fd84fd41 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -317,6 +317,7 @@ library XMonad.Util.Dmenu XMonad.Util.Dzen XMonad.Util.EZConfig + XMonad.Util.ExclusiveScratchpads XMonad.Util.ExtensibleState XMonad.Util.Font XMonad.Util.Image