-----------------------------------------------------------------------------
-- |
-- 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 (
  -- * 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 scrachpads 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]
(Int -> ReadS SPStorage)
-> ReadS [SPStorage]
-> ReadPrec SPStorage
-> ReadPrec [SPStorage]
-> Read 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
(Int -> SPStorage -> ShowS)
-> (SPStorage -> String)
-> ([SPStorage] -> ShowS)
-> Show SPStorage
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 Map String Window
forall k a. Map k a
M.empty
    extensionType :: SPStorage -> StateExtension
extensionType = SPStorage -> StateExtension
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) <- X SPStorage
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
    case String -> Map String Window -> Maybe Window
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 Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
ow
                    then String -> X ()
removeDynamicSP String
s
                    else Window -> X ()
showWindow Window
ow X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Window -> X ()
addDynamicSP String
s Window
w

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

spawnDynamicSP' :: Window -> X ()
spawnDynamicSP' :: Window -> X ()
spawnDynamicSP' Window
w = (WindowSet -> X ()) -> X ()
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowSet
s -> do
    let matchingWindows :: [Window]
matchingWindows = (Window -> Bool) -> [Window] -> [Window]
forall a. (a -> Bool) -> [a] -> [a]
filter (Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
w) (([Window]
-> (Stack Window -> [Window]) -> Maybe (Stack Window) -> [Window]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Stack Window -> [Window]
forall a. Stack a -> [a]
W.integrate (Maybe (Stack Window) -> [Window])
-> (WindowSet -> Maybe (Stack Window)) -> WindowSet -> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window))
-> (WindowSet -> Workspace String (Layout Window) Window)
-> WindowSet
-> Maybe (Stack Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> Workspace String (Layout Window) Window)
-> (WindowSet
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> WindowSet
-> Workspace String (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> Screen String (Layout Window) Window ScreenId ScreenDetail
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 = (SPStorage -> SPStorage) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ((SPStorage -> SPStorage) -> X ())
-> (SPStorage -> SPStorage) -> X ()
forall a b. (a -> b) -> a -> b
$ (Maybe Window -> Maybe Window) -> String -> SPStorage -> SPStorage
alterSPStorage (\Maybe Window
_ -> Window -> 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 = (SPStorage -> SPStorage) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ((SPStorage -> SPStorage) -> X ())
-> (SPStorage -> SPStorage) -> X ()
forall a b. (a -> b) -> a -> b
$ (Maybe Window -> Maybe Window) -> String -> SPStorage -> SPStorage
alterSPStorage (Maybe Window -> Maybe Window -> Maybe Window
forall a b. a -> b -> a
const Maybe Window
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 ((WindowSet -> WindowSet) -> X ())
-> (Window -> WindowSet -> WindowSet) -> Window -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Window -> WindowSet -> WindowSet
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 ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowSet
ws ->
    Window -> WindowSet -> WindowSet
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 (WindowSet -> WindowSet)
-> (WindowSet -> WindowSet) -> WindowSet -> WindowSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Window -> WindowSet -> WindowSet
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 (WindowSet -> String
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
ws) Window
w (WindowSet -> WindowSet) -> WindowSet -> WindowSet
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 (Map String Window -> SPStorage) -> Map String Window -> SPStorage
forall a b. (a -> b) -> a -> b
$ (Maybe Window -> Maybe Window)
-> String -> Map String Window -> Map String Window
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: