{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-}
module XMonad.Hooks.UrgencyHook (
withUrgencyHook, withUrgencyHookC,
UrgencyConfig(..), urgencyConfig,
SuppressWhen(..), RemindWhen(..),
focusUrgent, clearUrgents,
dzenUrgencyHook,
DzenUrgencyHook(..),
NoUrgencyHook(..),
BorderUrgencyHook(..),
FocusHook(..),
filterUrgencyHook, filterUrgencyHook',
minutes, seconds,
askUrgent, doAskUrgent,
readUrgents, withUrgents, clearUrgents',
StdoutUrgencyHook(..),
SpawnUrgencyHook(..),
UrgencyHook(urgencyHook),
Interval,
borderUrgencyHook, focusHook, spawnUrgencyHook, stdoutUrgencyHook
) where
import XMonad
import XMonad.Prelude (fi, delete, fromMaybe, listToMaybe, maybeToList, when, (\\))
import qualified XMonad.StackSet as W
import XMonad.Hooks.ManageHelpers (windowTag)
import XMonad.Util.Dzen (dzenWithArgs, seconds)
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Util.NamedWindows (getName)
import XMonad.Util.Timer (TimerId, startTimer, handleTimer)
import XMonad.Util.WindowProperties (getProp32)
import Data.Bits (testBit)
import qualified Data.Set as S
import System.IO (hPutStrLn, stderr)
import Foreign.C.Types (CLong)
withUrgencyHook :: (LayoutClass l Window, UrgencyHook h) =>
h -> XConfig l -> XConfig l
withUrgencyHook :: forall (l :: * -> *) h.
(LayoutClass l Atom, UrgencyHook h) =>
h -> XConfig l -> XConfig l
withUrgencyHook h
hook = forall (l :: * -> *) h.
(LayoutClass l Atom, UrgencyHook h) =>
h -> UrgencyConfig -> XConfig l -> XConfig l
withUrgencyHookC h
hook forall a. Default a => a
def
withUrgencyHookC :: (LayoutClass l Window, UrgencyHook h) =>
h -> UrgencyConfig -> XConfig l -> XConfig l
withUrgencyHookC :: forall (l :: * -> *) h.
(LayoutClass l Atom, UrgencyHook h) =>
h -> UrgencyConfig -> XConfig l -> XConfig l
withUrgencyHookC h
hook UrgencyConfig
urgConf XConfig l
conf = XConfig l
conf {
handleEventHook :: Event -> X All
handleEventHook = \Event
e -> forall h. UrgencyHook h => WithUrgencyHook h -> Event -> X ()
handleEvent (forall h. h -> UrgencyConfig -> WithUrgencyHook h
WithUrgencyHook h
hook UrgencyConfig
urgConf) Event
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (l :: * -> *). XConfig l -> Event -> X All
handleEventHook XConfig l
conf Event
e,
logHook :: X ()
logHook = SuppressWhen -> X ()
cleanupUrgents (UrgencyConfig -> SuppressWhen
suppressWhen UrgencyConfig
urgConf) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (l :: * -> *). XConfig l -> X ()
logHook XConfig l
conf,
startupHook :: X ()
startupHook = X ()
cleanupStaleUrgents forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (l :: * -> *). XConfig l -> X ()
startupHook XConfig l
conf
}
newtype Urgents = Urgents { Urgents -> [Atom]
fromUrgents :: [Window] } deriving (ReadPrec [Urgents]
ReadPrec Urgents
Int -> ReadS Urgents
ReadS [Urgents]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Urgents]
$creadListPrec :: ReadPrec [Urgents]
readPrec :: ReadPrec Urgents
$creadPrec :: ReadPrec Urgents
readList :: ReadS [Urgents]
$creadList :: ReadS [Urgents]
readsPrec :: Int -> ReadS Urgents
$creadsPrec :: Int -> ReadS Urgents
Read,Int -> Urgents -> ShowS
[Urgents] -> ShowS
Urgents -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [Urgents] -> ShowS
$cshowList :: [Urgents] -> ShowS
show :: Urgents -> WorkspaceId
$cshow :: Urgents -> WorkspaceId
showsPrec :: Int -> Urgents -> ShowS
$cshowsPrec :: Int -> Urgents -> ShowS
Show)
onUrgents :: ([Window] -> [Window]) -> Urgents -> Urgents
onUrgents :: ([Atom] -> [Atom]) -> Urgents -> Urgents
onUrgents [Atom] -> [Atom]
f = [Atom] -> Urgents
Urgents forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Atom] -> [Atom]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Urgents -> [Atom]
fromUrgents
instance ExtensionClass Urgents where
initialValue :: Urgents
initialValue = [Atom] -> Urgents
Urgents []
extensionType :: Urgents -> StateExtension
extensionType = forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension
data UrgencyConfig = UrgencyConfig
{ UrgencyConfig -> SuppressWhen
suppressWhen :: SuppressWhen
, UrgencyConfig -> RemindWhen
remindWhen :: RemindWhen
} deriving (ReadPrec [UrgencyConfig]
ReadPrec UrgencyConfig
Int -> ReadS UrgencyConfig
ReadS [UrgencyConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UrgencyConfig]
$creadListPrec :: ReadPrec [UrgencyConfig]
readPrec :: ReadPrec UrgencyConfig
$creadPrec :: ReadPrec UrgencyConfig
readList :: ReadS [UrgencyConfig]
$creadList :: ReadS [UrgencyConfig]
readsPrec :: Int -> ReadS UrgencyConfig
$creadsPrec :: Int -> ReadS UrgencyConfig
Read, Int -> UrgencyConfig -> ShowS
[UrgencyConfig] -> ShowS
UrgencyConfig -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [UrgencyConfig] -> ShowS
$cshowList :: [UrgencyConfig] -> ShowS
show :: UrgencyConfig -> WorkspaceId
$cshow :: UrgencyConfig -> WorkspaceId
showsPrec :: Int -> UrgencyConfig -> ShowS
$cshowsPrec :: Int -> UrgencyConfig -> ShowS
Show)
data SuppressWhen = Visible
| OnScreen
| Focused
| Never
deriving (ReadPrec [SuppressWhen]
ReadPrec SuppressWhen
Int -> ReadS SuppressWhen
ReadS [SuppressWhen]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SuppressWhen]
$creadListPrec :: ReadPrec [SuppressWhen]
readPrec :: ReadPrec SuppressWhen
$creadPrec :: ReadPrec SuppressWhen
readList :: ReadS [SuppressWhen]
$creadList :: ReadS [SuppressWhen]
readsPrec :: Int -> ReadS SuppressWhen
$creadsPrec :: Int -> ReadS SuppressWhen
Read, Int -> SuppressWhen -> ShowS
[SuppressWhen] -> ShowS
SuppressWhen -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [SuppressWhen] -> ShowS
$cshowList :: [SuppressWhen] -> ShowS
show :: SuppressWhen -> WorkspaceId
$cshow :: SuppressWhen -> WorkspaceId
showsPrec :: Int -> SuppressWhen -> ShowS
$cshowsPrec :: Int -> SuppressWhen -> ShowS
Show)
data RemindWhen = Dont
| Repeatedly Int Interval
| Every Interval
deriving (ReadPrec [RemindWhen]
ReadPrec RemindWhen
Int -> ReadS RemindWhen
ReadS [RemindWhen]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RemindWhen]
$creadListPrec :: ReadPrec [RemindWhen]
readPrec :: ReadPrec RemindWhen
$creadPrec :: ReadPrec RemindWhen
readList :: ReadS [RemindWhen]
$creadList :: ReadS [RemindWhen]
readsPrec :: Int -> ReadS RemindWhen
$creadsPrec :: Int -> ReadS RemindWhen
Read, Int -> RemindWhen -> ShowS
[RemindWhen] -> ShowS
RemindWhen -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [RemindWhen] -> ShowS
$cshowList :: [RemindWhen] -> ShowS
show :: RemindWhen -> WorkspaceId
$cshow :: RemindWhen -> WorkspaceId
showsPrec :: Int -> RemindWhen -> ShowS
$cshowsPrec :: Int -> RemindWhen -> ShowS
Show)
minutes :: Rational -> Rational
minutes :: Rational -> Rational
minutes Rational
secs = Rational
secs forall a. Num a => a -> a -> a
* Rational
60
urgencyConfig :: UrgencyConfig
urgencyConfig :: UrgencyConfig
urgencyConfig = forall a. Default a => a
def
{-# DEPRECATED urgencyConfig "Use def insetad." #-}
instance Default UrgencyConfig where
def :: UrgencyConfig
def = UrgencyConfig { suppressWhen :: SuppressWhen
suppressWhen = SuppressWhen
Visible, remindWhen :: RemindWhen
remindWhen = RemindWhen
Dont }
focusUrgent :: X ()
focusUrgent :: X ()
focusUrgent = forall a. ([Atom] -> X a) -> X a
withUrgents forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust ((WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe
clearUrgents :: X ()
clearUrgents :: X ()
clearUrgents = forall a. ([Atom] -> X a) -> X a
withUrgents [Atom] -> X ()
clearUrgents'
readUrgents :: X [Window]
readUrgents :: X [Atom]
readUrgents = forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets Urgents -> [Atom]
fromUrgents
withUrgents :: ([Window] -> X a) -> X a
withUrgents :: forall a. ([Atom] -> X a) -> X a
withUrgents [Atom] -> X a
f = X [Atom]
readUrgents forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Atom] -> X a
f
cleanupStaleUrgents :: X ()
cleanupStaleUrgents :: X ()
cleanupStaleUrgents = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
ws -> do
([Atom] -> [Atom]) -> X ()
adjustUrgents (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Bool
`W.member` WindowSet
ws))
([Reminder] -> [Reminder]) -> X ()
adjustReminders (forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Bool
`W.member` WindowSet
ws) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reminder -> Atom
window))
adjustUrgents :: ([Window] -> [Window]) -> X ()
adjustUrgents :: ([Atom] -> [Atom]) -> X ()
adjustUrgents = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Atom] -> [Atom]) -> Urgents -> Urgents
onUrgents
type Interval = Rational
data Reminder = Reminder { Reminder -> Int
timer :: TimerId
, Reminder -> Atom
window :: Window
, Reminder -> Rational
interval :: Interval
, Reminder -> Maybe Int
remaining :: Maybe Int
} deriving (Int -> Reminder -> ShowS
[Reminder] -> ShowS
Reminder -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [Reminder] -> ShowS
$cshowList :: [Reminder] -> ShowS
show :: Reminder -> WorkspaceId
$cshow :: Reminder -> WorkspaceId
showsPrec :: Int -> Reminder -> ShowS
$cshowsPrec :: Int -> Reminder -> ShowS
Show,ReadPrec [Reminder]
ReadPrec Reminder
Int -> ReadS Reminder
ReadS [Reminder]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Reminder]
$creadListPrec :: ReadPrec [Reminder]
readPrec :: ReadPrec Reminder
$creadPrec :: ReadPrec Reminder
readList :: ReadS [Reminder]
$creadList :: ReadS [Reminder]
readsPrec :: Int -> ReadS Reminder
$creadsPrec :: Int -> ReadS Reminder
Read,Reminder -> Reminder -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reminder -> Reminder -> Bool
$c/= :: Reminder -> Reminder -> Bool
== :: Reminder -> Reminder -> Bool
$c== :: Reminder -> Reminder -> Bool
Eq)
instance ExtensionClass [Reminder] where
initialValue :: [Reminder]
initialValue = []
extensionType :: [Reminder] -> StateExtension
extensionType = forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension
readReminders :: X [Reminder]
readReminders :: X [Reminder]
readReminders = forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
adjustReminders :: ([Reminder] -> [Reminder]) -> X ()
adjustReminders :: ([Reminder] -> [Reminder]) -> X ()
adjustReminders = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify
data WithUrgencyHook h = WithUrgencyHook h UrgencyConfig
deriving (ReadPrec [WithUrgencyHook h]
ReadPrec (WithUrgencyHook h)
ReadS [WithUrgencyHook h]
forall h. Read h => ReadPrec [WithUrgencyHook h]
forall h. Read h => ReadPrec (WithUrgencyHook h)
forall h. Read h => Int -> ReadS (WithUrgencyHook h)
forall h. Read h => ReadS [WithUrgencyHook h]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WithUrgencyHook h]
$creadListPrec :: forall h. Read h => ReadPrec [WithUrgencyHook h]
readPrec :: ReadPrec (WithUrgencyHook h)
$creadPrec :: forall h. Read h => ReadPrec (WithUrgencyHook h)
readList :: ReadS [WithUrgencyHook h]
$creadList :: forall h. Read h => ReadS [WithUrgencyHook h]
readsPrec :: Int -> ReadS (WithUrgencyHook h)
$creadsPrec :: forall h. Read h => Int -> ReadS (WithUrgencyHook h)
Read, Int -> WithUrgencyHook h -> ShowS
forall h. Show h => Int -> WithUrgencyHook h -> ShowS
forall h. Show h => [WithUrgencyHook h] -> ShowS
forall h. Show h => WithUrgencyHook h -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [WithUrgencyHook h] -> ShowS
$cshowList :: forall h. Show h => [WithUrgencyHook h] -> ShowS
show :: WithUrgencyHook h -> WorkspaceId
$cshow :: forall h. Show h => WithUrgencyHook h -> WorkspaceId
showsPrec :: Int -> WithUrgencyHook h -> ShowS
$cshowsPrec :: forall h. Show h => Int -> WithUrgencyHook h -> ShowS
Show)
changeNetWMState :: Display -> Window -> ([CLong] -> [CLong]) -> X ()
changeNetWMState :: Display -> Atom -> ([CLong] -> [CLong]) -> X ()
changeNetWMState Display
dpy Atom
w [CLong] -> [CLong]
f = do
Atom
wmstate <- WorkspaceId -> X Atom
getAtom WorkspaceId
"_NET_WM_STATE"
[CLong]
wstate <- forall a. a -> Maybe a -> a
fromMaybe [] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Atom -> Atom -> X (Maybe [CLong])
getProp32 Atom
wmstate Atom
w
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Atom -> Atom -> Atom -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Atom
w Atom
wmstate Atom
aTOM CInt
propModeReplace ([CLong] -> [CLong]
f [CLong]
wstate)
forall (m :: * -> *) a. Monad m => a -> m a
return ()
addNetWMState :: Display -> Window -> Atom -> X ()
addNetWMState :: Display -> Atom -> Atom -> X ()
addNetWMState Display
dpy Atom
w Atom
atom = Display -> Atom -> ([CLong] -> [CLong]) -> X ()
changeNetWMState Display
dpy Atom
w (forall a b. (Integral a, Num b) => a -> b
fromIntegral Atom
atom forall a. a -> [a] -> [a]
:)
removeNetWMState :: Display -> Window -> Atom -> X ()
removeNetWMState :: Display -> Atom -> Atom -> X ()
removeNetWMState Display
dpy Atom
w Atom
atom = Display -> Atom -> ([CLong] -> [CLong]) -> X ()
changeNetWMState Display
dpy Atom
w forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> [a]
delete (forall a b. (Integral a, Num b) => a -> b
fromIntegral Atom
atom)
getNetWMState :: Window -> X [CLong]
getNetWMState :: Atom -> X [CLong]
getNetWMState Atom
w = do
Atom
a_wmstate <- WorkspaceId -> X Atom
getAtom WorkspaceId
"_NET_WM_STATE"
forall a. a -> Maybe a -> a
fromMaybe [] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Atom -> Atom -> X (Maybe [CLong])
getProp32 Atom
a_wmstate Atom
w
handleEvent :: UrgencyHook h => WithUrgencyHook h -> Event -> X ()
handleEvent :: forall h. UrgencyHook h => WithUrgencyHook h -> Event -> X ()
handleEvent WithUrgencyHook h
wuh Event
event =
case Event
event of
PropertyEvent { ev_event_type :: Event -> EventType
ev_event_type = EventType
t, ev_atom :: Event -> Atom
ev_atom = Atom
a, ev_window :: Event -> Atom
ev_window = Atom
w } ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EventType
t forall a. Eq a => a -> a -> Bool
== EventType
propertyNotify Bool -> Bool -> Bool
&& Atom
a forall a. Eq a => a -> a -> Bool
== Atom
wM_HINTS) forall a b. (a -> b) -> a -> b
$ forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
WMHints { wmh_flags :: WMHints -> CLong
wmh_flags = CLong
flags } <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Atom -> IO WMHints
getWMHints Display
dpy Atom
w
if forall a. Bits a => a -> Int -> Bool
testBit CLong
flags Int
urgencyHintBit then Atom -> X ()
markUrgent Atom
w else Atom -> X ()
markNotUrgent Atom
w
DestroyWindowEvent {ev_window :: Event -> Atom
ev_window = Atom
w} ->
Atom -> X ()
markNotUrgent Atom
w
ClientMessageEvent {ev_event_display :: Event -> Display
ev_event_display = Display
dpy, ev_window :: Event -> Atom
ev_window = Atom
w, ev_message_type :: Event -> Atom
ev_message_type = Atom
t, ev_data :: Event -> [CInt]
ev_data = CInt
action:[CInt]
atoms} -> do
Atom
a_wmstate <- WorkspaceId -> X Atom
getAtom WorkspaceId
"_NET_WM_STATE"
Atom
a_da <- WorkspaceId -> X Atom
getAtom WorkspaceId
"_NET_WM_STATE_DEMANDS_ATTENTION"
[CLong]
wstate <- Atom -> X [CLong]
getNetWMState Atom
w
let demandsAttention :: Bool
demandsAttention = forall a b. (Integral a, Num b) => a -> b
fromIntegral Atom
a_da forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CLong]
wstate
remove :: CInt
remove = CInt
0
add :: CInt
add = CInt
1
toggle :: CInt
toggle = CInt
2
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Atom
t forall a. Eq a => a -> a -> Bool
== Atom
a_wmstate Bool -> Bool -> Bool
&& forall a b. (Integral a, Num b) => a -> b
fromIntegral Atom
a_da forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CInt]
atoms) forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
action forall a. Eq a => a -> a -> Bool
== CInt
add Bool -> Bool -> Bool
|| (CInt
action forall a. Eq a => a -> a -> Bool
== CInt
toggle Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
demandsAttention)) forall a b. (a -> b) -> a -> b
$ do
Atom -> X ()
markUrgent Atom
w
Display -> Atom -> Atom -> X ()
addNetWMState Display
dpy Atom
w Atom
a_da
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
action forall a. Eq a => a -> a -> Bool
== CInt
remove Bool -> Bool -> Bool
|| (CInt
action forall a. Eq a => a -> a -> Bool
== CInt
toggle Bool -> Bool -> Bool
&& Bool
demandsAttention)) forall a b. (a -> b) -> a -> b
$ do
Atom -> X ()
markNotUrgent Atom
w
Display -> Atom -> Atom -> X ()
removeNetWMState Display
dpy Atom
w Atom
a_da
Event
_ ->
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall {a}. Reminder -> X (Maybe a)
handleReminder forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X [Reminder]
readReminders
where handleReminder :: Reminder -> X (Maybe a)
handleReminder Reminder
reminder = forall a. Int -> Event -> X (Maybe a) -> X (Maybe a)
handleTimer (Reminder -> Int
timer Reminder
reminder) Event
event forall a b. (a -> b) -> a -> b
$ forall h a.
UrgencyHook h =>
WithUrgencyHook h -> Reminder -> X (Maybe a)
reminderHook WithUrgencyHook h
wuh Reminder
reminder
markUrgent :: Atom -> X ()
markUrgent Atom
w = do
([Atom] -> [Atom]) -> X ()
adjustUrgents (\[Atom]
ws -> if Atom
w forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Atom]
ws then [Atom]
ws else Atom
w forall a. a -> [a] -> [a]
: [Atom]
ws)
forall h. UrgencyHook h => WithUrgencyHook h -> Atom -> X ()
callUrgencyHook WithUrgencyHook h
wuh Atom
w
forall a. a -> X a -> X a
userCodeDef () forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall (l :: * -> *). XConfig l -> X ()
logHook forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config)
markNotUrgent :: Atom -> X ()
markNotUrgent Atom
w = do
([Atom] -> [Atom]) -> X ()
adjustUrgents (forall a. Eq a => a -> [a] -> [a]
delete Atom
w) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Reminder] -> [Reminder]) -> X ()
adjustReminders (forall a. (a -> Bool) -> [a] -> [a]
filter forall a b. (a -> b) -> a -> b
$ (Atom
w forall a. Eq a => a -> a -> Bool
/=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reminder -> Atom
window)
forall a. a -> X a -> X a
userCodeDef () forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall (l :: * -> *). XConfig l -> X ()
logHook forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config)
callUrgencyHook :: UrgencyHook h => WithUrgencyHook h -> Window -> X ()
callUrgencyHook :: forall h. UrgencyHook h => WithUrgencyHook h -> Atom -> X ()
callUrgencyHook (WithUrgencyHook h
hook UrgencyConfig { suppressWhen :: UrgencyConfig -> SuppressWhen
suppressWhen = SuppressWhen
sw, remindWhen :: UrgencyConfig -> RemindWhen
remindWhen = RemindWhen
rw }) Atom
w =
X Bool -> X () -> X ()
whenX (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SuppressWhen -> Atom -> X Bool
shouldSuppress SuppressWhen
sw Atom
w) forall a b. (a -> b) -> a -> b
$ do
forall a. a -> X a -> X a
userCodeDef () forall a b. (a -> b) -> a -> b
$ forall h. UrgencyHook h => h -> Atom -> X ()
urgencyHook h
hook Atom
w
case RemindWhen
rw of
Repeatedly Int
times Rational
int -> Atom -> Rational -> Maybe Int -> X ()
addReminder Atom
w Rational
int forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Int
times
Every Rational
int -> Atom -> Rational -> Maybe Int -> X ()
addReminder Atom
w Rational
int forall a. Maybe a
Nothing
RemindWhen
Dont -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
addReminder :: Window -> Rational -> Maybe Int -> X ()
addReminder :: Atom -> Rational -> Maybe Int -> X ()
addReminder Atom
w Rational
int Maybe Int
times = do
Int
timerId <- Rational -> X Int
startTimer Rational
int
let reminder :: Reminder
reminder = Int -> Atom -> Rational -> Maybe Int -> Reminder
Reminder Int
timerId Atom
w Rational
int Maybe Int
times
([Reminder] -> [Reminder]) -> X ()
adjustReminders (\[Reminder]
rs -> if Atom
w forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map Reminder -> Atom
window [Reminder]
rs then [Reminder]
rs else Reminder
reminder forall a. a -> [a] -> [a]
: [Reminder]
rs)
reminderHook :: UrgencyHook h => WithUrgencyHook h -> Reminder -> X (Maybe a)
reminderHook :: forall h a.
UrgencyHook h =>
WithUrgencyHook h -> Reminder -> X (Maybe a)
reminderHook (WithUrgencyHook h
hook UrgencyConfig
_) Reminder
reminder = do
case Reminder -> Maybe Int
remaining Reminder
reminder of
Just Int
x | Int
x forall a. Ord a => a -> a -> Bool
> Int
0 -> Maybe Int -> X ()
remind forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Int
x forall a. Num a => a -> a -> a
- Int
1)
Just Int
_ -> ([Reminder] -> [Reminder]) -> X ()
adjustReminders forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> [a]
delete Reminder
reminder
Maybe Int
Nothing -> Maybe Int -> X ()
remind forall a. Maybe a
Nothing
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
where remind :: Maybe Int -> X ()
remind Maybe Int
remaining' = do forall a. X a -> X (Maybe a)
userCode forall a b. (a -> b) -> a -> b
$ forall h. UrgencyHook h => h -> Atom -> X ()
urgencyHook h
hook (Reminder -> Atom
window Reminder
reminder)
([Reminder] -> [Reminder]) -> X ()
adjustReminders forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> [a]
delete Reminder
reminder
Atom -> Rational -> Maybe Int -> X ()
addReminder (Reminder -> Atom
window Reminder
reminder) (Reminder -> Rational
interval Reminder
reminder) Maybe Int
remaining'
shouldSuppress :: SuppressWhen -> Window -> X Bool
shouldSuppress :: SuppressWhen -> Atom -> X Bool
shouldSuppress SuppressWhen
sw Atom
w = forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Atom
w forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SuppressWhen -> X [Atom]
suppressibleWindows SuppressWhen
sw
cleanupUrgents :: SuppressWhen -> X ()
cleanupUrgents :: SuppressWhen -> X ()
cleanupUrgents SuppressWhen
sw = [Atom] -> X ()
clearUrgents' forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SuppressWhen -> X [Atom]
suppressibleWindows SuppressWhen
sw
clearUrgents' :: [Window] -> X ()
clearUrgents' :: [Atom] -> X ()
clearUrgents' [Atom]
ws = do
Atom
a_da <- WorkspaceId -> X Atom
getAtom WorkspaceId
"_NET_WM_STATE_DEMANDS_ATTENTION"
Display
dpy <- forall a. (Display -> X a) -> X a
withDisplay forall (m :: * -> *) a. Monad m => a -> m a
return
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Atom
w -> Display -> Atom -> Atom -> X ()
removeNetWMState Display
dpy Atom
w Atom
a_da) [Atom]
ws
([Atom] -> [Atom]) -> X ()
adjustUrgents (forall a. Eq a => [a] -> [a] -> [a]
\\ [Atom]
ws) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Reminder] -> [Reminder]) -> X ()
adjustReminders (forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Atom]
ws) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reminder -> Atom
window))
suppressibleWindows :: SuppressWhen -> X [Window]
suppressibleWindows :: SuppressWhen -> X [Atom]
suppressibleWindows SuppressWhen
Visible = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> Set Atom
mapped
suppressibleWindows SuppressWhen
OnScreen = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a s sd. StackSet i l a s sd -> [a]
W.index forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
suppressibleWindows SuppressWhen
Focused = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> [a]
maybeToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
suppressibleWindows SuppressWhen
Never = forall (m :: * -> *) a. Monad m => a -> m a
return []
class UrgencyHook h where
urgencyHook :: h -> Window -> X ()
instance UrgencyHook (Window -> X ()) where
urgencyHook :: (Atom -> X ()) -> Atom -> X ()
urgencyHook = forall a. a -> a
id
data NoUrgencyHook = NoUrgencyHook deriving (ReadPrec [NoUrgencyHook]
ReadPrec NoUrgencyHook
Int -> ReadS NoUrgencyHook
ReadS [NoUrgencyHook]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NoUrgencyHook]
$creadListPrec :: ReadPrec [NoUrgencyHook]
readPrec :: ReadPrec NoUrgencyHook
$creadPrec :: ReadPrec NoUrgencyHook
readList :: ReadS [NoUrgencyHook]
$creadList :: ReadS [NoUrgencyHook]
readsPrec :: Int -> ReadS NoUrgencyHook
$creadsPrec :: Int -> ReadS NoUrgencyHook
Read, Int -> NoUrgencyHook -> ShowS
[NoUrgencyHook] -> ShowS
NoUrgencyHook -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [NoUrgencyHook] -> ShowS
$cshowList :: [NoUrgencyHook] -> ShowS
show :: NoUrgencyHook -> WorkspaceId
$cshow :: NoUrgencyHook -> WorkspaceId
showsPrec :: Int -> NoUrgencyHook -> ShowS
$cshowsPrec :: Int -> NoUrgencyHook -> ShowS
Show)
instance UrgencyHook NoUrgencyHook where
urgencyHook :: NoUrgencyHook -> Atom -> X ()
urgencyHook NoUrgencyHook
_ Atom
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
data DzenUrgencyHook = DzenUrgencyHook {
DzenUrgencyHook -> Int
duration :: Int,
DzenUrgencyHook -> [WorkspaceId]
args :: [String]
}
deriving (ReadPrec [DzenUrgencyHook]
ReadPrec DzenUrgencyHook
Int -> ReadS DzenUrgencyHook
ReadS [DzenUrgencyHook]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DzenUrgencyHook]
$creadListPrec :: ReadPrec [DzenUrgencyHook]
readPrec :: ReadPrec DzenUrgencyHook
$creadPrec :: ReadPrec DzenUrgencyHook
readList :: ReadS [DzenUrgencyHook]
$creadList :: ReadS [DzenUrgencyHook]
readsPrec :: Int -> ReadS DzenUrgencyHook
$creadsPrec :: Int -> ReadS DzenUrgencyHook
Read, Int -> DzenUrgencyHook -> ShowS
[DzenUrgencyHook] -> ShowS
DzenUrgencyHook -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [DzenUrgencyHook] -> ShowS
$cshowList :: [DzenUrgencyHook] -> ShowS
show :: DzenUrgencyHook -> WorkspaceId
$cshow :: DzenUrgencyHook -> WorkspaceId
showsPrec :: Int -> DzenUrgencyHook -> ShowS
$cshowsPrec :: Int -> DzenUrgencyHook -> ShowS
Show)
instance UrgencyHook DzenUrgencyHook where
urgencyHook :: DzenUrgencyHook -> Atom -> X ()
urgencyHook DzenUrgencyHook { duration :: DzenUrgencyHook -> Int
duration = Int
d, args :: DzenUrgencyHook -> [WorkspaceId]
args = [WorkspaceId]
a } Atom
w = do
NamedWindow
name <- Atom -> X NamedWindow
getName Atom
w
WindowSet
ws <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Maybe i
W.findTag Atom
w WindowSet
ws) (forall {a}. Show a => a -> WorkspaceId -> X ()
flash NamedWindow
name)
where flash :: a -> WorkspaceId -> X ()
flash a
name WorkspaceId
index =
WorkspaceId -> [WorkspaceId] -> Int -> X ()
dzenWithArgs (forall a. Show a => a -> WorkspaceId
show a
name forall a. [a] -> [a] -> [a]
++ WorkspaceId
" requests your attention on workspace " forall a. [a] -> [a] -> [a]
++ WorkspaceId
index) [WorkspaceId]
a Int
d
focusHook :: Window -> X ()
focusHook :: Atom -> X ()
focusHook = forall h. UrgencyHook h => h -> Atom -> X ()
urgencyHook FocusHook
FocusHook
data FocusHook = FocusHook deriving (ReadPrec [FocusHook]
ReadPrec FocusHook
Int -> ReadS FocusHook
ReadS [FocusHook]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FocusHook]
$creadListPrec :: ReadPrec [FocusHook]
readPrec :: ReadPrec FocusHook
$creadPrec :: ReadPrec FocusHook
readList :: ReadS [FocusHook]
$creadList :: ReadS [FocusHook]
readsPrec :: Int -> ReadS FocusHook
$creadsPrec :: Int -> ReadS FocusHook
Read, Int -> FocusHook -> ShowS
[FocusHook] -> ShowS
FocusHook -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [FocusHook] -> ShowS
$cshowList :: [FocusHook] -> ShowS
show :: FocusHook -> WorkspaceId
$cshow :: FocusHook -> WorkspaceId
showsPrec :: Int -> FocusHook -> ShowS
$cshowsPrec :: Int -> FocusHook -> ShowS
Show)
instance UrgencyHook FocusHook where
urgencyHook :: FocusHook -> Atom -> X ()
urgencyHook FocusHook
_ Atom
_ = X ()
focusUrgent
borderUrgencyHook :: String -> Window -> X ()
borderUrgencyHook :: WorkspaceId -> Atom -> X ()
borderUrgencyHook = forall h. UrgencyHook h => h -> Atom -> X ()
urgencyHook forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> BorderUrgencyHook
BorderUrgencyHook
newtype BorderUrgencyHook = BorderUrgencyHook { BorderUrgencyHook -> WorkspaceId
urgencyBorderColor :: String }
deriving (ReadPrec [BorderUrgencyHook]
ReadPrec BorderUrgencyHook
Int -> ReadS BorderUrgencyHook
ReadS [BorderUrgencyHook]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BorderUrgencyHook]
$creadListPrec :: ReadPrec [BorderUrgencyHook]
readPrec :: ReadPrec BorderUrgencyHook
$creadPrec :: ReadPrec BorderUrgencyHook
readList :: ReadS [BorderUrgencyHook]
$creadList :: ReadS [BorderUrgencyHook]
readsPrec :: Int -> ReadS BorderUrgencyHook
$creadsPrec :: Int -> ReadS BorderUrgencyHook
Read, Int -> BorderUrgencyHook -> ShowS
[BorderUrgencyHook] -> ShowS
BorderUrgencyHook -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [BorderUrgencyHook] -> ShowS
$cshowList :: [BorderUrgencyHook] -> ShowS
show :: BorderUrgencyHook -> WorkspaceId
$cshow :: BorderUrgencyHook -> WorkspaceId
showsPrec :: Int -> BorderUrgencyHook -> ShowS
$cshowsPrec :: Int -> BorderUrgencyHook -> ShowS
Show)
instance UrgencyHook BorderUrgencyHook where
urgencyHook :: BorderUrgencyHook -> Atom -> X ()
urgencyHook BorderUrgencyHook { urgencyBorderColor :: BorderUrgencyHook -> WorkspaceId
urgencyBorderColor = WorkspaceId
cs } Atom
w =
forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
Maybe Atom
c' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (Display -> WorkspaceId -> IO (Maybe Atom)
initColor Display
dpy WorkspaceId
cs)
case Maybe Atom
c' of
Just Atom
c -> Display -> Atom -> WorkspaceId -> Atom -> X ()
setWindowBorderWithFallback Display
dpy Atom
w WorkspaceId
cs Atom
c
Maybe Atom
_ -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Handle -> WorkspaceId -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [WorkspaceId
"Warning: bad urgentBorderColor "
,forall a. Show a => a -> WorkspaceId
show WorkspaceId
cs
,WorkspaceId
" in BorderUrgencyHook"
]
dzenUrgencyHook :: DzenUrgencyHook
dzenUrgencyHook :: DzenUrgencyHook
dzenUrgencyHook = forall a. Default a => a
def
instance Default DzenUrgencyHook where
def :: DzenUrgencyHook
def = DzenUrgencyHook { duration :: Int
duration = Rational -> Int
seconds Rational
5, args :: [WorkspaceId]
args = [] }
spawnUrgencyHook :: String -> Window -> X ()
spawnUrgencyHook :: WorkspaceId -> Atom -> X ()
spawnUrgencyHook = forall h. UrgencyHook h => h -> Atom -> X ()
urgencyHook forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> SpawnUrgencyHook
SpawnUrgencyHook
newtype SpawnUrgencyHook = SpawnUrgencyHook String deriving (ReadPrec [SpawnUrgencyHook]
ReadPrec SpawnUrgencyHook
Int -> ReadS SpawnUrgencyHook
ReadS [SpawnUrgencyHook]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SpawnUrgencyHook]
$creadListPrec :: ReadPrec [SpawnUrgencyHook]
readPrec :: ReadPrec SpawnUrgencyHook
$creadPrec :: ReadPrec SpawnUrgencyHook
readList :: ReadS [SpawnUrgencyHook]
$creadList :: ReadS [SpawnUrgencyHook]
readsPrec :: Int -> ReadS SpawnUrgencyHook
$creadsPrec :: Int -> ReadS SpawnUrgencyHook
Read, Int -> SpawnUrgencyHook -> ShowS
[SpawnUrgencyHook] -> ShowS
SpawnUrgencyHook -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [SpawnUrgencyHook] -> ShowS
$cshowList :: [SpawnUrgencyHook] -> ShowS
show :: SpawnUrgencyHook -> WorkspaceId
$cshow :: SpawnUrgencyHook -> WorkspaceId
showsPrec :: Int -> SpawnUrgencyHook -> ShowS
$cshowsPrec :: Int -> SpawnUrgencyHook -> ShowS
Show)
instance UrgencyHook SpawnUrgencyHook where
urgencyHook :: SpawnUrgencyHook -> Atom -> X ()
urgencyHook (SpawnUrgencyHook WorkspaceId
prefix) Atom
w = forall (m :: * -> *). MonadIO m => WorkspaceId -> m ()
spawn forall a b. (a -> b) -> a -> b
$ WorkspaceId
prefix forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> WorkspaceId
show Atom
w
stdoutUrgencyHook :: Window -> X ()
stdoutUrgencyHook :: Atom -> X ()
stdoutUrgencyHook = forall h. UrgencyHook h => h -> Atom -> X ()
urgencyHook StdoutUrgencyHook
StdoutUrgencyHook
data StdoutUrgencyHook = StdoutUrgencyHook deriving (ReadPrec [StdoutUrgencyHook]
ReadPrec StdoutUrgencyHook
Int -> ReadS StdoutUrgencyHook
ReadS [StdoutUrgencyHook]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StdoutUrgencyHook]
$creadListPrec :: ReadPrec [StdoutUrgencyHook]
readPrec :: ReadPrec StdoutUrgencyHook
$creadPrec :: ReadPrec StdoutUrgencyHook
readList :: ReadS [StdoutUrgencyHook]
$creadList :: ReadS [StdoutUrgencyHook]
readsPrec :: Int -> ReadS StdoutUrgencyHook
$creadsPrec :: Int -> ReadS StdoutUrgencyHook
Read, Int -> StdoutUrgencyHook -> ShowS
[StdoutUrgencyHook] -> ShowS
StdoutUrgencyHook -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [StdoutUrgencyHook] -> ShowS
$cshowList :: [StdoutUrgencyHook] -> ShowS
show :: StdoutUrgencyHook -> WorkspaceId
$cshow :: StdoutUrgencyHook -> WorkspaceId
showsPrec :: Int -> StdoutUrgencyHook -> ShowS
$cshowsPrec :: Int -> StdoutUrgencyHook -> ShowS
Show)
instance UrgencyHook StdoutUrgencyHook where
urgencyHook :: StdoutUrgencyHook -> Atom -> X ()
urgencyHook StdoutUrgencyHook
_ Atom
w = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ WorkspaceId -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ WorkspaceId
"Urgent: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> WorkspaceId
show Atom
w
filterUrgencyHook :: [WorkspaceId] -> Window -> X ()
filterUrgencyHook :: [WorkspaceId] -> Atom -> X ()
filterUrgencyHook [WorkspaceId]
skips = Query Bool -> Atom -> X ()
filterUrgencyHook' forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [WorkspaceId]
skips) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query (Maybe WorkspaceId)
windowTag
filterUrgencyHook' :: Query Bool -> Window -> X ()
filterUrgencyHook' :: Query Bool -> Atom -> X ()
filterUrgencyHook' Query Bool
q Atom
w = X Bool -> X () -> X ()
whenX (forall a. Query a -> Atom -> X a
runQuery Query Bool
q Atom
w) ([Atom] -> X ()
clearUrgents' [Atom
w])
askUrgent :: Window -> X ()
askUrgent :: Atom -> X ()
askUrgent Atom
w = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
Atom
rw <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Atom
theRoot
Atom
a_wmstate <- WorkspaceId -> X Atom
getAtom WorkspaceId
"_NET_WM_STATE"
Atom
a_da <- WorkspaceId -> X Atom
getAtom WorkspaceId
"_NET_WM_STATE_DEMANDS_ATTENTION"
let state_add :: CInt
state_add = CInt
1
let source_pager :: CInt
source_pager = CInt
2
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent forall a b. (a -> b) -> a -> b
$ \XEventPtr
e -> do
XEventPtr -> EventType -> IO ()
setEventType XEventPtr
e EventType
clientMessage
XEventPtr -> Atom -> Atom -> CInt -> [CInt] -> IO ()
setClientMessageEvent' XEventPtr
e Atom
w Atom
a_wmstate CInt
32 [CInt
state_add, forall a b. (Integral a, Num b) => a -> b
fi Atom
a_da, CInt
0, CInt
source_pager]
Display -> Atom -> Bool -> Atom -> XEventPtr -> IO ()
sendEvent Display
dpy Atom
rw Bool
False (Atom
substructureRedirectMask forall a. Bits a => a -> a -> a
.|. Atom
substructureNotifyMask) XEventPtr
e
doAskUrgent :: ManageHook
doAskUrgent :: Query (Endo WindowSet)
doAskUrgent = forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Atom
w -> forall a. X a -> Query a
liftX (Atom -> X ()
askUrgent Atom
w) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Monoid a => a
mempty