-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.DynamicScratchpads
-- Description :  Dynamically declare any window as a scratchpad.
-- Copyright   :  (c) Robin Oberschweiber <mephory@mephory.com>
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Robin Obercshweiber <mephory@mephory.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Dynamically declare any window as a scratchpad.
--
-----------------------------------------------------------------------------

module XMonad.Util.DynamicScratchpads {-# DEPRECATED "Use the dynamic scratchpad facility of XMonad.Util.NamedScratchpad instead." #-} (
  -- * Usage
  -- $usage
  makeDynamicSP,
  spawnDynamicSP
  ) where

import Graphics.X11.Types
import XMonad.Core
import XMonad.Operations
import qualified Data.Map as M
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS


-- $usage
-- Allows you to dynamically declare windows as scratchpads. You can bind a key
-- to make a window start/stop being a scratchpad, and another key to
-- spawn/hide that scratchpad.
--
-- Like with XMonad.Util.NamedScratchpad, you have to have a workspace called
-- NSP, where hidden scratchpads will be moved to.
--
-- You can declare dynamic scratchpads in your xmonad.hs like so:
--
-- import XMonad.Util.DynamicScratchpads
--
-- , ((modm .|. shiftMask, xK_a), withFocused $ makeDynamicSP "dyn1")
-- , ((modm .|. shiftMask, xK_b), withFocused $ makeDynamicSP "dyn2")
-- , ((modm              , xK_a), spawnDynamicSP "dyn1")
-- , ((modm              , xK_b), spawnDynamicSP "dyn2")

-- | Stores dynamic scratchpads as a map of name to window
newtype SPStorage = SPStorage (M.Map String Window)
    deriving (ReadPrec [SPStorage]
ReadPrec SPStorage
Int -> ReadS SPStorage
ReadS [SPStorage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SPStorage]
$creadListPrec :: ReadPrec [SPStorage]
readPrec :: ReadPrec SPStorage
$creadPrec :: ReadPrec SPStorage
readList :: ReadS [SPStorage]
$creadList :: ReadS [SPStorage]
readsPrec :: Int -> ReadS SPStorage
$creadsPrec :: Int -> ReadS SPStorage
Read,Int -> SPStorage -> ShowS
[SPStorage] -> ShowS
SPStorage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SPStorage] -> ShowS
$cshowList :: [SPStorage] -> ShowS
show :: SPStorage -> String
$cshow :: SPStorage -> String
showsPrec :: Int -> SPStorage -> ShowS
$cshowsPrec :: Int -> SPStorage -> ShowS
Show)

instance ExtensionClass SPStorage where
    initialValue :: SPStorage
initialValue = Map String Window -> SPStorage
SPStorage forall k a. Map k a
M.empty
    extensionType :: SPStorage -> StateExtension
extensionType = forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension

-- | Makes a window a dynamic scratchpad with the given name, or stop a window
-- | from being a dynamic scratchpad, if it already is.
makeDynamicSP :: String -- ^ Scratchpad name
              -> Window -- ^ Window to be made a scratchpad
              -> X ()
makeDynamicSP :: String -> Window -> X ()
makeDynamicSP String
s Window
w = do
    (SPStorage Map String Window
m) <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
    case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
s Map String Window
m of
        Maybe Window
Nothing -> String -> Window -> X ()
addDynamicSP String
s Window
w
        Just Window
ow  -> if Window
w forall a. Eq a => a -> a -> Bool
== Window
ow
                    then String -> X ()
removeDynamicSP String
s
                    else Window -> X ()
showWindow Window
ow forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Window -> X ()
addDynamicSP String
s Window
w
{-# DEPRECATED makeDynamicSP "Use XMonad.Util.NamedScratchpad.toggleDynamicNSP instead" #-}

-- | Spawn the specified dynamic scratchpad
spawnDynamicSP :: String -- ^ Scratchpad name
               -> X ()
spawnDynamicSP :: String -> X ()
spawnDynamicSP String
s = do
    (SPStorage Map String Window
m) <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Window -> X ()
spawnDynamicSP' (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
s Map String Window
m)
{-# DEPRECATED spawnDynamicSP "Use XMonad.Util.NamedScratchpad.dynamicNSPAction instead" #-}

spawnDynamicSP' :: Window -> X ()
spawnDynamicSP' :: Window -> X ()
spawnDynamicSP' Window
w = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
s -> do
    let matchingWindows :: [Window]
matchingWindows = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
== Window
w) ((forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a. Stack a -> [a]
W.integrate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current) WindowSet
s)
    case [Window]
matchingWindows of
        [] -> Window -> X ()
showWindow Window
w
        [Window]
_  -> Window -> X ()
hideWindow Window
w

-- | Make a window a dynamic scratchpad
addDynamicSP :: String -> Window -> X ()
addDynamicSP :: String -> Window -> X ()
addDynamicSP String
s Window
w = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify forall a b. (a -> b) -> a -> b
$ (Maybe Window -> Maybe Window) -> String -> SPStorage -> SPStorage
alterSPStorage (\Maybe Window
_ -> forall a. a -> Maybe a
Just Window
w) String
s

-- | Make a window stop being a dynamic scratchpad
removeDynamicSP :: String -> X ()
removeDynamicSP :: String -> X ()
removeDynamicSP String
s = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify forall a b. (a -> b) -> a -> b
$ (Maybe Window -> Maybe Window) -> String -> SPStorage -> SPStorage
alterSPStorage (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) String
s

-- | Moves window to the scratchpad workspace, effectively hiding it
hideWindow :: Window -> X ()
hideWindow :: Window -> X ()
hideWindow = (WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> a -> StackSet i l a s sd -> StackSet i l a s sd
W.shiftWin String
"NSP"

-- | Move window to current workspace and focus it
showWindow :: Window -> X ()
showWindow :: Window -> X ()
showWindow Window
w = (WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ \WindowSet
ws ->
    forall s a i l sd.
(Eq s, Eq a, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.focusWindow Window
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> a -> StackSet i l a s sd -> StackSet i l a s sd
W.shiftWin (forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
ws) Window
w forall a b. (a -> b) -> a -> b
$ WindowSet
ws

alterSPStorage :: (Maybe Window -> Maybe Window) -> String -> SPStorage -> SPStorage
alterSPStorage :: (Maybe Window -> Maybe Window) -> String -> SPStorage -> SPStorage
alterSPStorage Maybe Window -> Maybe Window
f String
k (SPStorage Map String Window
m) = Map String Window -> SPStorage
SPStorage forall a b. (a -> b) -> a -> b
$ forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe Window -> Maybe Window
f String
k Map String Window
m

-- vim:ts=4:shiftwidth=4:softtabstop=4:expandtab: