{-# LANGUAGE InstanceSigs #-}
module XMonad.Hooks.ShowWName (
showWNameLogHook,
SWNConfig(..),
flashName,
) where
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
import XMonad
import XMonad.Layout.ShowWName (SWNConfig (..))
import XMonad.Prelude
import XMonad.Util.XUtils (WindowConfig (..), showSimpleWindow)
import Control.Concurrent (threadDelay)
showWNameLogHook :: SWNConfig -> X ()
showWNameLogHook :: SWNConfig -> X ()
showWNameLogHook SWNConfig
cfg = do
LastShown WorkspaceId
s <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
WorkspaceId
foc <- forall a. (WindowSet -> X a) -> X a
withWindowSet (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> i
W.currentTag)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (WorkspaceId
s forall a. Eq a => a -> a -> Bool
== WorkspaceId
foc) forall a b. (a -> b) -> a -> b
$ do
SWNConfig -> X ()
flashName SWNConfig
cfg
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put (WorkspaceId -> LastShown
LastShown WorkspaceId
foc)
flashName :: SWNConfig -> X ()
flashName :: SWNConfig -> X ()
flashName SWNConfig
cfg = do
WorkspaceId
n <- forall a. (WindowSet -> X a) -> X a
withWindowSet (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> i
W.currentTag)
WindowConfig -> [WorkspaceId] -> X Window
showSimpleWindow WindowConfig
cfg' [WorkspaceId
n] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadIO m => IO () -> m ProcessID
xfork forall a b. (a -> b) -> a -> b
$ do
Display
dpy <- WorkspaceId -> IO Display
openDisplay WorkspaceId
""
Int -> IO ()
threadDelay (forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ SWNConfig -> Rational
swn_fade SWNConfig
cfg forall a. Num a => a -> a -> a
* Rational
1000000)
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO ()
destroyWindow Display
dpy Window
w
Display -> IO ()
closeDisplay Display
dpy
where
cfg' :: WindowConfig
cfg' :: WindowConfig
cfg' = forall a. Default a => a
def{ winFont :: WorkspaceId
winFont = SWNConfig -> WorkspaceId
swn_font SWNConfig
cfg, winBg :: WorkspaceId
winBg = SWNConfig -> WorkspaceId
swn_bgcolor SWNConfig
cfg, winFg :: WorkspaceId
winFg = SWNConfig -> WorkspaceId
swn_color SWNConfig
cfg }
newtype LastShown = LastShown WorkspaceId
deriving (Int -> LastShown -> ShowS
[LastShown] -> ShowS
LastShown -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [LastShown] -> ShowS
$cshowList :: [LastShown] -> ShowS
show :: LastShown -> WorkspaceId
$cshow :: LastShown -> WorkspaceId
showsPrec :: Int -> LastShown -> ShowS
$cshowsPrec :: Int -> LastShown -> ShowS
Show, ReadPrec [LastShown]
ReadPrec LastShown
Int -> ReadS LastShown
ReadS [LastShown]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LastShown]
$creadListPrec :: ReadPrec [LastShown]
readPrec :: ReadPrec LastShown
$creadPrec :: ReadPrec LastShown
readList :: ReadS [LastShown]
$creadList :: ReadS [LastShown]
readsPrec :: Int -> ReadS LastShown
$creadsPrec :: Int -> ReadS LastShown
Read)
instance ExtensionClass LastShown where
initialValue :: LastShown
initialValue :: LastShown
initialValue = WorkspaceId -> LastShown
LastShown WorkspaceId
""
extensionType :: LastShown -> StateExtension
extensionType :: LastShown -> StateExtension
extensionType = forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension