module XMonad.Util.Loggers.NamedScratchpad (
nspTrackStartup
,nspTrackHook
,nspActiveIcon
,nspActive
,nspActive') where
import XMonad.Core
import Graphics.X11.Xlib (Window)
import Graphics.X11.Xlib.Extras (Event(..))
import XMonad.Util.Loggers (Logger)
import XMonad.Util.NamedScratchpad (NamedScratchpad(..))
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Prelude (All (..), chr, foldM, forM)
import qualified Data.IntMap as M
import qualified XMonad.StackSet as W (allWindows)
newtype NSPTrack = NSPTrack [Maybe Window]
instance ExtensionClass NSPTrack where
initialValue :: NSPTrack
initialValue = [Maybe Window] -> NSPTrack
NSPTrack []
nspTrackStartup :: [NamedScratchpad] -> X ()
nspTrackStartup :: [NamedScratchpad] -> X ()
nspTrackStartup [NamedScratchpad]
ns = do
let ns'i :: IntMap (Maybe a)
ns'i = forall a. [(Int, a)] -> IntMap a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) [NamedScratchpad]
ns
IntMap (Maybe Window)
ns' <- forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([NamedScratchpad]
-> IntMap (Maybe Window) -> Window -> X (IntMap (Maybe Window))
isSp [NamedScratchpad]
ns) forall {a}. IntMap (Maybe a)
ns'i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a i l s sd. Eq a => StackSet i l a s sd -> [a]
W.allWindows
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put ([Maybe Window] -> NSPTrack
NSPTrack (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> [(Int, a)]
M.toAscList IntMap (Maybe Window)
ns'))
isSp :: [NamedScratchpad] -> M.IntMap (Maybe Window) -> Window -> X (M.IntMap (Maybe Window))
isSp :: [NamedScratchpad]
-> IntMap (Maybe Window) -> Window -> X (IntMap (Maybe Window))
isSp [NamedScratchpad]
ns IntMap (Maybe Window)
ws Window
w = do
Maybe Int
n <- forall a. Query a -> Window -> X a
runQuery ([NamedScratchpad] -> Query (Maybe Int)
scratchpadWindow [NamedScratchpad]
ns) Window
w
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe Int
n of
Maybe Int
Nothing -> IntMap (Maybe Window)
ws
Just Int
n' -> forall a. Int -> a -> IntMap a -> IntMap a
M.insert Int
n' (forall a. a -> Maybe a
Just Window
w) IntMap (Maybe Window)
ws
scratchpadWindow :: [NamedScratchpad] -> Query (Maybe Int)
scratchpadWindow :: [NamedScratchpad] -> Query (Maybe Int)
scratchpadWindow [NamedScratchpad]
ns = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Maybe Int -> (Int, NamedScratchpad) -> Query (Maybe Int)
sp' forall a. Maybe a
Nothing (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [NamedScratchpad]
ns)
where sp' :: Maybe Int -> (Int,NamedScratchpad) -> Query (Maybe Int)
sp' :: Maybe Int -> (Int, NamedScratchpad) -> Query (Maybe Int)
sp' r :: Maybe Int
r@(Just Int
_) (Int, NamedScratchpad)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
r
sp' Maybe Int
Nothing (Int
n,NS String
_ String
_ Query Bool
q ManageHook
_) = Query Bool
q forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
p -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
p then forall a. a -> Maybe a
Just Int
n else forall a. Maybe a
Nothing
nspTrackHook :: [NamedScratchpad] -> Event -> X All
nspTrackHook :: [NamedScratchpad] -> Event -> X All
nspTrackHook [NamedScratchpad]
_ DestroyWindowEvent{ev_window :: Event -> Window
ev_window = Window
w} = do
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify forall a b. (a -> b) -> a -> b
$ \(NSPTrack [Maybe Window]
ws) -> [Maybe Window] -> NSPTrack
NSPTrack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Maybe Window
sw -> if Maybe Window
sw forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Window
w then forall a. Maybe a
Nothing else Maybe Window
sw) [Maybe Window]
ws
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)
nspTrackHook [NamedScratchpad]
ns ConfigureRequestEvent{ev_window :: Event -> Window
ev_window = Window
w} = do
NSPTrack [Maybe Window]
ws <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
[Maybe Window]
ws' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Integer
0 :: Integer ..] [Maybe Window]
ws [NamedScratchpad]
ns) forall a b. (a -> b) -> a -> b
$ \(Integer
_,Maybe Window
w',NS String
_ String
_ Query Bool
q ManageHook
_) -> do
Bool
p <- forall a. Query a -> Window -> X a
runQuery Query Bool
q Window
w
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
p then forall a. a -> Maybe a
Just Window
w else Maybe Window
w'
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put forall a b. (a -> b) -> a -> b
$ [Maybe Window] -> NSPTrack
NSPTrack [Maybe Window]
ws'
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)
nspTrackHook [NamedScratchpad]
_ Event
_ = forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)
nspActiveIcon :: [Char] -> (String -> String) -> (String -> String) -> Logger
nspActiveIcon :: String -> (String -> String) -> (String -> String) -> Logger
nspActiveIcon String
icns String -> String
act String -> String
inact = do
NSPTrack [Maybe Window]
ws <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Maybe Window]
ws
then forall a. Maybe a
Nothing
else let icon' :: Int -> Char
icon' Int
n = if Int
n forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length String
icns then String
icns forall a. [a] -> Int -> a
!! Int
n else Char
'\NUL'
icon :: Int -> String
icon Int
n = let c :: Char
c = Int -> Char
icon' Int
n
in [if Char
c forall a. Eq a => a -> a -> Bool
== Char
'\NUL' then Int -> Char
chr (Int
0x2460 forall a. Num a => a -> a -> a
+ Int
n) else Char
c]
ckact :: Int -> Maybe a -> String
ckact Int
n Maybe a
w = let icn :: String
icn = Int -> String
icon Int
n
in case Maybe a
w of
Maybe a
Nothing -> String -> String
inact String
icn
Just a
_ -> String -> String
act String
icn
s :: String
s = [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a}. Int -> Maybe a -> String
ckact [Int
0..] [Maybe Window]
ws
in forall a. a -> Maybe a
Just String
s
nspActive :: [String] -> (String -> String) -> (String -> String) -> Logger
nspActive :: [String] -> (String -> String) -> (String -> String) -> Logger
nspActive [String]
icns String -> String
act String -> String
inact = do
NSPTrack [Maybe Window]
ws <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Maybe Window]
ws
then forall a. Maybe a
Nothing
else let ckact :: Int -> Maybe a -> String
ckact Int
n Maybe a
w = let icn :: String
icn = [String]
icns forall a. [a] -> Int -> a
!! Int
n
in case Maybe a
w of
Maybe a
Nothing -> String -> String
inact String
icn
Just a
_ -> String -> String
act String
icn
s :: String
s = [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a}. Int -> Maybe a -> String
ckact [Int
0..] [Maybe Window]
ws
in forall a. a -> Maybe a
Just String
s
nspActive' :: [NamedScratchpad] -> (String -> String) -> (String -> String) -> Logger
nspActive' :: [NamedScratchpad]
-> (String -> String) -> (String -> String) -> Logger
nspActive' [NamedScratchpad]
ns = [String] -> (String -> String) -> (String -> String) -> Logger
nspActive (forall a b. (a -> b) -> [a] -> [b]
map NamedScratchpad -> String
name [NamedScratchpad]
ns)