diff options
Diffstat (limited to 'XMonad')
| -rw-r--r-- | XMonad/Util/NamedScratchpad.hs | 138 |
1 files changed, 138 insertions, 0 deletions
diff --git a/XMonad/Util/NamedScratchpad.hs b/XMonad/Util/NamedScratchpad.hs new file mode 100644 index 0000000..8d08e47 --- /dev/null +++ b/XMonad/Util/NamedScratchpad.hs @@ -0,0 +1,138 @@ +{-# LANGUAGE PatternGuards #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.NamedScratchpad +-- Copyright : (c) Konstantin Sobolev <konstantin.sobolev@gmail.com> +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Konstantin Sobolev <konstantin.sobolev@gmail.com> +-- Stability : unstable +-- Portability : unportable +-- +-- Named scratchpads that support several arbitrary applications at the same time. +-- +----------------------------------------------------------------------------- + +module XMonad.Util.NamedScratchpad ( + -- * Usage + -- $usage + NamedScratchpad(..), + NamedScratchpads, + namedScratchpadAction, + namedScratchpadManageHook, + namedScratchpadFilterOutWorkspace + ) where + +import XMonad +import XMonad.Core +import XMonad.ManageHook (composeAll,doFloat) +import XMonad.Hooks.ManageHelpers (doRectFloat) +import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace) + +import Control.Monad (filterM) +import Data.Maybe (maybe,listToMaybe) + +import qualified XMonad.StackSet as W + + +-- $usage +-- Allows to have several floating scratchpads running different applications. +-- Bind a key to 'namedScratchpadSpawnAction'. +-- Pressing it will spawn configured application, or bring it to the current +-- workspace if it already exists. +-- Pressing the key with the application on the current workspace will +-- send it to a hidden workspace called @NSP@. +-- +-- If you already have a workspace called @NSP@, it will use that. +-- @NSP@ will also appear in xmobar and dzen status bars. You can tweak your +-- @dynamicLog@ settings to filter it out if you like. +-- +-- Create named scratchpads configuration in your xmonad.hs like this: +-- +-- > import XMonad.StackSet as W +-- > import XMonad.ManageHook +-- > import XMonad.Util.NamedScratchpad +-- > +-- > scratchpads = [ +-- > -- run htop in xterm, find it by title, use default geometry +-- > NS "htop" "xterm -e htop" (title =? "htop") Nothing , +-- > -- run stardict, find it by class name, place the window +-- > -- 1/6 of screen width from the left, 1/6 of screen height +-- > -- from the top, 2/3 of screen width by 2/3 of screen height +-- > NS "stardict" "stardict" (className =? "Stardict") +-- > (Just $ W.RationalRect (1/6) (1/6) (2/3) (2/3)) +-- > ] +-- +-- Add keybindings: +-- +-- > , ((modMask x .|. controlMask .|. shiftMask, xK_t), namedScratchpadAction scratchpads "htop") +-- > , ((modMask x .|. controlMask .|. shiftMask, xK_s), namedScratchpadAction scratchpads "stardict") +-- +-- ... and a manage hook: +-- +-- > , manageHook = namedScratchpadManageHook scratchpads +-- +-- For detailed instruction on editing the key binding see +-- "XMonad.Doc.Extending#Editing_key_bindings" +-- + +-- | Single named scratchpad configuration +data NamedScratchpad = NS { name :: String -- ^ Scratchpad name + , cmd :: String -- ^ Command used to run application + , query :: Query Bool -- ^ Query to find already running application + , rect :: Maybe W.RationalRect -- ^ Floating window geometry + } + +-- | Named scratchpads configuration +type NamedScratchpads = [NamedScratchpad] + +-- | Finds named scratchpad configuration by name +findByName :: NamedScratchpads -> String -> Maybe NamedScratchpad +findByName c s = listToMaybe $ filter ((s==).name) c + +-- | Runs application which should appear in specified scratchpad +runApplication :: NamedScratchpad -> X () +runApplication = spawn . cmd + +-- | Action to pop up specified named scratchpad +namedScratchpadAction :: NamedScratchpads -- ^ Named scratchpads configuration + -> String -- ^ Scratchpad name + -> X () +namedScratchpadAction confs n + | Just conf <- findByName confs n = withWindowSet $ \s -> do + -- try to find it on the current workspace + filterCurrent <- filterM (runQuery (query conf)) + ( (maybe [] W.integrate . W.stack . + W.workspace . W.current) s) + case filterCurrent of + (x:_) -> do + -- create hidden workspace if it doesn't exist + if null (filter ((== scratchpadWorkspaceTag) . W.tag) (W.workspaces s)) + then addHiddenWorkspace scratchpadWorkspaceTag + else return () + -- push window there + windows $ W.shiftWin scratchpadWorkspaceTag x + [] -> do + -- try to find it on all workspaces + filterAll <- filterM (runQuery (query conf)) (W.allWindows s) + case filterAll of + (x:_) -> windows $ W.shiftWin (W.currentTag s) x + [] -> runApplication conf + + | otherwise = return () + +-- tag of the scratchpad workspace +scratchpadWorkspaceTag :: String +scratchpadWorkspaceTag = "NSP" + +-- | Manage hook to use with named scratchpads +namedScratchpadManageHook :: NamedScratchpads -- ^ Named scratchpads configuration + -> ManageHook +namedScratchpadManageHook = composeAll . fmap (\c -> query c --> maybe doFloat doRectFloat (rect c)) + +-- | Transforms a workspace list containing the NSP workspace into one that +-- doesn't contain it. Intended for use with logHooks. +namedScratchpadFilterOutWorkspace :: [WindowSpace] -> [WindowSpace] +namedScratchpadFilterOutWorkspace = filter (\(W.Workspace tag _ _) -> tag /= scratchpadWorkspaceTag) + +-- vim:ts=4:shiftwidth=4:softtabstop=4:expandtab:foldlevel=20: |