{-# 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 s <- X LastShown
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
foc <- withWindowSet (pure . W.currentTag)
unless (s == foc) $ do
flashName cfg
XS.put (LastShown foc)
flashName :: SWNConfig -> X ()
flashName :: SWNConfig -> X ()
flashName SWNConfig
cfg = do
n <- (WindowSet -> X WorkspaceId) -> X WorkspaceId
forall a. (WindowSet -> X a) -> X a
withWindowSet (WorkspaceId -> X WorkspaceId
forall a. a -> X a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WorkspaceId -> X WorkspaceId)
-> (WindowSet -> WorkspaceId) -> WindowSet -> X WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> WorkspaceId
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag)
showSimpleWindow cfg' [n] >>= \Window
w -> X ProcessID -> X ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (X ProcessID -> X ()) -> (IO () -> X ProcessID) -> IO () -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> X ProcessID
forall (m :: * -> *). MonadIO m => IO () -> m ProcessID
xfork (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ do
dpy <- WorkspaceId -> IO Display
openDisplay WorkspaceId
""
threadDelay (fromEnum $ swn_fade cfg * 1000000)
void $ destroyWindow dpy w
closeDisplay dpy
where
cfg' :: WindowConfig
cfg' :: WindowConfig
cfg' = WindowConfig
forall a. Default a => a
def{ winFont = swn_font cfg, winBg = swn_bgcolor cfg, winFg = swn_color cfg }
newtype LastShown = LastShown WorkspaceId
deriving (Int -> LastShown -> ShowS
[LastShown] -> ShowS
LastShown -> WorkspaceId
(Int -> LastShown -> ShowS)
-> (LastShown -> WorkspaceId)
-> ([LastShown] -> ShowS)
-> Show LastShown
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LastShown -> ShowS
showsPrec :: Int -> LastShown -> ShowS
$cshow :: LastShown -> WorkspaceId
show :: LastShown -> WorkspaceId
$cshowList :: [LastShown] -> ShowS
showList :: [LastShown] -> ShowS
Show, ReadPrec [LastShown]
ReadPrec LastShown
Int -> ReadS LastShown
ReadS [LastShown]
(Int -> ReadS LastShown)
-> ReadS [LastShown]
-> ReadPrec LastShown
-> ReadPrec [LastShown]
-> Read LastShown
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS LastShown
readsPrec :: Int -> ReadS LastShown
$creadList :: ReadS [LastShown]
readList :: ReadS [LastShown]
$creadPrec :: ReadPrec LastShown
readPrec :: ReadPrec LastShown
$creadListPrec :: ReadPrec [LastShown]
readListPrec :: ReadPrec [LastShown]
Read)
instance ExtensionClass LastShown where
initialValue :: LastShown
initialValue :: LastShown
initialValue = WorkspaceId -> LastShown
LastShown WorkspaceId
""
extensionType :: LastShown -> StateExtension
extensionType :: LastShown -> StateExtension
extensionType = LastShown -> StateExtension
forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension