From ed47f19f500575db2ed3e5b2ed2ea9a1392b8f6b Mon Sep 17 00:00:00 2001
From: "konstantin.sobolev" <konstantin.sobolev@gmail.com>
Date: Sun, 19 Apr 2009 06:55:42 +0200
Subject: NamedScratchpad
Ignore-this: b442cb08123d2413e0bb144a73bf3f57
darcs-hash:20090419045542-fb31b-b1a385de0fbefc5c16c9f5db9c58a4e55bc4753a.gz
---
XMonad/Util/NamedScratchpad.hs | 138 +++++++++++++++++++++++++++++++++++++++++
1 file changed, 138 insertions(+)
create mode 100644 XMonad/Util/NamedScratchpad.hs
(limited to 'XMonad')
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:
--
cgit v1.2.3