NamedScratchpad

Ignore-this: b442cb08123d2413e0bb144a73bf3f57

darcs-hash:20090419045542-fb31b-b1a385de0fbefc5c16c9f5db9c58a4e55bc4753a.gz

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: