diff --git a/src/Client/Configuration.hs b/src/Client/Configuration.hs index 4a349198..4fcf8e61 100644 --- a/src/Client/Configuration.hs +++ b/src/Client/Configuration.hs @@ -47,6 +47,7 @@ module Client.Configuration , configJumpModifier , configDigraphs , configNotifications + , configNotifyWhile , configNetworkPalette , extensionPath @@ -76,7 +77,7 @@ import Client.Commands.Interpolation (Macro) import Client.Commands.Recognizer (Recognizer) import Client.Configuration.Colors (attrSpec) import Client.Configuration.Macros (macroMapSpec) -import Client.Configuration.Notifications (NotifyWith, notifySpec, notifyWithDefault) +import Client.Configuration.Notifications (NotifyWith, NotifyWhile(NotifyWhileUnfocused), notifySpec, notifyWithDefault, notifyWhileSpec) import Client.Configuration.ServerSettings import Client.EventLoop.Actions import Client.Image.Palette @@ -128,6 +129,7 @@ data Configuration = Configuration , _configJumpModifier :: [Modifier] -- ^ Modifier used for jumping windows , _configDigraphs :: Map Digraph Text -- ^ Extra digraphs , _configNotifications :: NotifyWith + , _configNotifyWhile :: NotifyWhile } deriving Show @@ -298,7 +300,9 @@ configurationSpec = sectionsSpec "config-file" $ _configDigraphs <- sec' mempty "extra-digraphs" (Map.fromList <$> listSpec digraphSpec) "Extra digraphs" _configNotifications <- sec' notifyWithDefault "notifications" notifySpec - "Whether and how to show desktop notifications" + "Whether and how to show notifications. Notification data is passed as arguments to custom commands." + _configNotifyWhile <- sec' NotifyWhileUnfocused "notify-while" notifyWhileSpec + "When notifications (if enabled) may be displayed" return (\def -> let _configDefaults = snd ssDefUpdate def _configServers = buildServerMap _configDefaults ssUpdates diff --git a/src/Client/Configuration/Notifications.hs b/src/Client/Configuration/Notifications.hs index c93524b5..f40fba99 100644 --- a/src/Client/Configuration/Notifications.hs +++ b/src/Client/Configuration/Notifications.hs @@ -6,7 +6,7 @@ Copyright : (c) TheDaemoness, 2023 License : ISC Maintainer : emertens@gmail.com -} -module Client.Configuration.Notifications ( NotifyWith(..), notifyCmd, notifySpec, notifyWithDefault ) where +module Client.Configuration.Notifications ( NotifyWith(..), NotifyWhile(..), notifyCmd, notifySpec, notifyWithDefault, notifyWhileSpec ) where import Config.Schema (ValueSpec, atomSpec, nonemptySpec, stringSpec, ()) import qualified Data.Text.Lazy as LText @@ -21,6 +21,12 @@ data NotifyWith | NotifyWithTerminalNotifier deriving Show +data NotifyWhile + = NotifyWhileUnfocused + | NotifyWhileFocused + | NotifyWhileAlways + deriving Show + notifyCmd :: NotifyWith -> Maybe ((LText.Text, LText.Text) -> ProcessConfig () () ()) notifyCmd (NotifyWithCustom (cmd:args)) = Just $ \(header, body) -> proc cmd (args ++ [LText.unpack header, LText.unpack body]) @@ -49,3 +55,9 @@ notifySpec = NotifyWithOsaScript <$ atomSpec "osascript" NotifyWithTerminalNotifier <$ atomSpec "terminal-notifier" NotifyWithCustom . NonEmpty.toList <$> nonemptySpec stringSpec + +notifyWhileSpec :: ValueSpec NotifyWhile +notifyWhileSpec = + NotifyWhileUnfocused <$ atomSpec "unfocused" + NotifyWhileFocused <$ atomSpec "focused" + NotifyWhileAlways <$ atomSpec "always" diff --git a/src/Client/EventLoop.hs b/src/Client/EventLoop.hs index 4e05f23b..5b79acd6 100644 --- a/src/Client/EventLoop.hs +++ b/src/Client/EventLoop.hs @@ -182,7 +182,7 @@ processLogEntries = processNotifications :: ClientState -> IO () processNotifications st = case notifyCmd (view (clientConfig . configNotifications) st) of - Just cmd | not (view clientUiFocused st) -> traverse_ (spawn cmd) (view clientNotifications st) + Just cmd | clientMayNotify st -> traverse_ (spawn cmd) (view clientNotifications st) _ -> return () where -- TODO: May be a nicer way to handle notification failure than just silently squashing the exception diff --git a/src/Client/State.hs b/src/Client/State.hs index e6e6eec2..2e49e1d3 100644 --- a/src/Client/State.hs +++ b/src/Client/State.hs @@ -61,6 +61,7 @@ module Client.State , buildMatcher , clientToggleHideMeta , channelUserList + , clientMayNotify , consumeInput , currentCompletionList @@ -115,6 +116,7 @@ module Client.State import Client.CApi import Client.Commands.WordCompletion import Client.Configuration +import Client.Configuration.Notifications (NotifyWhile(..)) import Client.Configuration.ServerSettings import Client.Configuration.Sts import Client.Image.Message @@ -672,6 +674,13 @@ addNotify True focus wl st focusText (NetworkFocus net) = LText.fromChunks ["Notice from ", net] focusText (ChannelFocus net chan) = LText.fromChunks ["Activity on ", net, ":", idText chan] +clientMayNotify :: ClientState -> Bool +clientMayNotify st = case view (clientConfig . configNotifyWhile) st of + NotifyWhileUnfocused -> not $ _clientUiFocused st + NotifyWhileFocused -> _clientUiFocused st + NotifyWhileAlways -> True + + toWindowLine :: MessageRendererParams -> WindowLineImportance -> ClientMessage -> WindowLine toWindowLine params importance msg = WindowLine { _wlSummary = msgSummary (view msgBody msg)