From 84caf9d5975d27e452566ce24589ae16db2423b3 Mon Sep 17 00:00:00 2001 From: Eric Mertens Date: Wed, 31 Jul 2024 13:47:35 -0700 Subject: [PATCH 1/2] Add basic support for message-tags --- bot/irc-core-bot.cabal | 2 +- glirc.cabal | 2 +- lib/ChangeLog.md | 4 ++++ lib/irc-core.cabal | 2 +- lib/src/Irc/Message.hs | 14 ++++++++++++-- src/Client/Commands/Queries.hs | 4 ++-- src/Client/Image/Message.hs | 7 +++++++ src/Client/Image/Palette.hs | 3 +++ src/Client/Message.hs | 5 ++++- src/Client/State/Network.hs | 2 +- src/Client/View/Help.hs | 2 +- 11 files changed, 37 insertions(+), 10 deletions(-) diff --git a/bot/irc-core-bot.cabal b/bot/irc-core-bot.cabal index 3e903ccc..7a722e7f 100644 --- a/bot/irc-core-bot.cabal +++ b/bot/irc-core-bot.cabal @@ -31,7 +31,7 @@ executable irc-core-bot base >=4.9 && <4.21, bytestring >=0.10 && <0.13, hookup ^>=0.8, - irc-core ^>=2.12, + irc-core ^>=2.13, random >=1.1 && <1.3, text >=1.2 && <2.2, containers ^>={0.6, 0.7}, diff --git a/glirc.cabal b/glirc.cabal index 51caeeca..04216c68 100644 --- a/glirc.cabal +++ b/glirc.cabal @@ -181,7 +181,7 @@ library githash ^>=0.1.6, hashable >=1.2.4 && <1.6, hookup ^>=0.8, - irc-core ^>=2.12, + irc-core ^>=2.13, kan-extensions >=5.0 && <5.3, lens >=4.14 && <5.4, random >=1.1 && <1.3, diff --git a/lib/ChangeLog.md b/lib/ChangeLog.md index 81e0ad51..741c65c9 100644 --- a/lib/ChangeLog.md +++ b/lib/ChangeLog.md @@ -1,5 +1,9 @@ # Revision history for irc-core +## 2.13 + +* Added constructors for TAGMSG from messages-tags + ## 2.12 * Added constructors for AWAY diff --git a/lib/irc-core.cabal b/lib/irc-core.cabal index 0a315f30..8b882a60 100644 --- a/lib/irc-core.cabal +++ b/lib/irc-core.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: irc-core -version: 2.12 +version: 2.13 synopsis: IRC core library for glirc description: IRC core library for glirc . diff --git a/lib/src/Irc/Message.hs b/lib/src/Irc/Message.hs index 45e6a041..3a806b15 100644 --- a/lib/src/Irc/Message.hs +++ b/lib/src/Irc/Message.hs @@ -75,6 +75,7 @@ data IrcMsg | Wallops !Source !Text -- ^ Braodcast message: Source, message | Invite !Source !Identifier !Identifier -- ^ sender target channel | Away !Source (Maybe Text) + | Tagmsg !Source !Identifier -- ^ source target deriving Show data Source = Source { srcUser :: {-# UNPACK #-}!UserInfo, srcAcct :: !Text } @@ -213,6 +214,12 @@ cookIrcMsg msg = , message <- view msgParams msg -> Away source (listToMaybe message) + "TAGMSG" + | Just source <- msgSource msg + , [target] <- view msgParams msg -> + Tagmsg source (mkId target) + + _ -> UnknownMsg msg -- | Parse a CTCP encoded message: @@ -247,7 +254,7 @@ msgTarget me msg = Part _ chan _ -> TargetWindow chan Quit user _ -> TargetUser (userNick (srcUser user)) Kick _ chan _ _ -> TargetWindow chan - Kill _ _ _ -> TargetNetwork + Kill{} -> TargetNetwork Topic _ chan _ -> TargetWindow chan Invite{} -> TargetNetwork Privmsg src tgt _ -> directed (srcUser src) tgt @@ -266,6 +273,7 @@ msgTarget me msg = Chghost user _ _ -> TargetUser (userNick (srcUser user)) Wallops _ _ -> TargetNetwork Away user _ -> TargetExisting (userNick (srcUser user)) + Tagmsg src tgt -> directed (srcUser src) tgt where directed src tgt | Text.null (userHost src) = TargetNetwork -- server message @@ -308,6 +316,7 @@ msgActor msg = Chghost x _ _ -> Just x Wallops x _ -> Just x Away x _ -> Just x + Tagmsg x _ -> Just x renderSource :: Source -> Text renderSource (Source u "") = renderUserInfo u @@ -340,11 +349,12 @@ ircMsgText msg = Authenticate{} -> "" BatchStart{} -> "" BatchEnd{} -> "" - Invite _ _ _ -> "" + Invite{} -> "" Chghost x a b -> Text.unwords [renderSource x, a, b] Wallops x t -> Text.unwords [renderSource x, t] Away x (Just t) -> Text.unwords [renderSource x, "away", t] Away x Nothing -> Text.unwords [renderSource x, "back"] + Tagmsg x _ -> renderSource x capCmdText :: CapCmd -> Text capCmdText cmd = diff --git a/src/Client/Commands/Queries.hs b/src/Client/Commands/Queries.hs index 90fae5e6..c45d70bf 100644 --- a/src/Client/Commands/Queries.hs +++ b/src/Client/Commands/Queries.hs @@ -11,11 +11,11 @@ Maintainer : emertens@gmail.com module Client.Commands.Queries (queryCommands) where -import Client.Commands.Arguments.Spec (optionalArg, remainingArg, simpleToken, extensionArg, Args, tokenArg) +import Client.Commands.Arguments.Spec (optionalArg, remainingArg, simpleToken, tokenArg) import Client.Commands.Docs (queriesDocs, cmdDoc) import Client.Commands.TabCompletion (noNetworkTab, simpleNetworkTab) import Client.Commands.Types (commandSuccess, commandSuccessUpdateCS, Command(Command), CommandImpl(NetworkCommand), CommandSection(CommandSection), NetworkCommand) -import Client.State (changeSubfocus, ClientState) +import Client.State (changeSubfocus) import Client.State.Focus (Subfocus(FocusChanList, FocusWho)) import Client.State.Network (sendMsg, csChannelList, clsElist, csPingStatus, _PingConnecting, csWhoReply, csNetwork) import Client.WhoReply (newWhoReply) diff --git a/src/Client/Image/Message.hs b/src/Client/Image/Message.hs index ae8dc151..d5c57db8 100644 --- a/src/Client/Image/Message.hs +++ b/src/Client/Image/Message.hs @@ -286,6 +286,7 @@ ircLinePrefix !rp body = Account user _ -> who user <> " account:" Chghost ui _ _ -> who ui <> " chghost:" + Tagmsg{} -> mempty -- | Render a chat message given a rendering mode, the sigils of the user @@ -308,6 +309,7 @@ ircLineImage !rp body = Nick {} -> mempty Authenticate{} -> "***" Away {} -> mempty + Tagmsg {} -> mempty Error txt -> parseIrcText pal txt Topic _ _ txt -> @@ -544,6 +546,10 @@ fullIrcLineImage !rp body = string (view palUsrChg pal) "back " <> who user + Tagmsg user _ -> + string quietAttr "tagm " <> + who user + renderCapCmd :: CapCmd -> Text renderCapCmd cmd = @@ -1214,6 +1220,7 @@ metadataImg pal msg = AcctSummary who -> Just (char (view palUsrChg pal) '*', who, Nothing) AwaySummary who True -> Just (char (view palAway pal) 'a', who, Nothing) AwaySummary who False -> Just (char (view palUsrChg pal) 'b', who, Nothing) + TagmSummary who -> Just (char (view palTagmsg pal) 't', who, Nothing) _ -> Nothing -- | Image used when treating ignored chat messages as metadata diff --git a/src/Client/Image/Palette.hs b/src/Client/Image/Palette.hs index 23b80e1d..fe327996 100644 --- a/src/Client/Image/Palette.hs +++ b/src/Client/Image/Palette.hs @@ -42,6 +42,7 @@ module Client.Image.Palette , palModes , palUsrChg , palIgnore + , palTagmsg -- * Lenses (Network) , palCModes @@ -95,6 +96,7 @@ data Palette = Palette , _palPart :: Attr , _palUsrChg :: Attr , _palIgnore :: Attr + , _palTagmsg :: Attr -- ^ color of TAGMSG sigil } deriving Show @@ -139,6 +141,7 @@ defaultPalette = Palette , _palModes = metaLo , _palUsrChg = metaLo , _palIgnore = withForeColor defAttr white + , _palTagmsg = metaLo } where metaNo = withForeColor defAttr brightBlack diff --git a/src/Client/Message.hs b/src/Client/Message.hs index 43628b67..192ded99 100644 --- a/src/Client/Message.hs +++ b/src/Client/Message.hs @@ -71,11 +71,12 @@ data IrcSummary | PartSummary {-# UNPACK #-} !Identifier | NickSummary {-# UNPACK #-} !Identifier {-# UNPACK #-} !Identifier | ReplySummary {-# UNPACK #-} !ReplyCode - | ChatSummary {-# UNPACK #-} !UserInfo + | ChatSummary {-# UNPACK #-} !UserInfo -- userinfo to help with ignore rules | CtcpSummary {-# UNPACK #-} !Identifier | ChngSummary {-# UNPACK #-} !Identifier -- ^ Chghost command | AcctSummary {-# UNPACK #-} !Identifier -- ^ Account command | AwaySummary {-# UNPACK #-} !Identifier !Bool + | TagmSummary {-# UNPACK #-} !Identifier -- ^ TAGMSG command | NoSummary deriving (Eq, Show) @@ -111,6 +112,7 @@ ircSummary msg = Account who _ -> AcctSummary (userNick (srcUser who)) Chghost who _ _ -> ChngSummary (userNick (srcUser who)) Away who mb -> AwaySummary (userNick (srcUser who)) (isJust mb) + Tagmsg who _ -> TagmSummary (userNick (srcUser who)) _ -> NoSummary quitKind :: Maybe Text -> QuitKind @@ -131,5 +133,6 @@ summaryActor s = AcctSummary who -> Just who ChngSummary who -> Just who AwaySummary who _ -> Just who + TagmSummary who -> Just who ReplySummary {} -> Nothing NoSummary -> Nothing diff --git a/src/Client/State/Network.hs b/src/Client/State/Network.hs index 1f465a8f..96001894 100644 --- a/src/Client/State/Network.hs +++ b/src/Client/State/Network.hs @@ -834,7 +834,7 @@ selectCaps cs offered = (supported `intersect` Map.keys capMap) ["multi-prefix", "batch", "znc.in/playback", "znc.in/self-message" , "cap-notify", "extended-join", "account-notify", "chghost" , "userhost-in-names", "account-tag", "solanum.chat/identify-msg" - , "solanum.chat/realhost", "away-notify"] + , "solanum.chat/realhost", "away-notify", "message-tags"] -- logic for using IRCv3.2 server-time if available and falling back -- to ZNC's specific extension otherwise. diff --git a/src/Client/View/Help.hs b/src/Client/View/Help.hs index 5a4f81c7..89a39946 100644 --- a/src/Client/View/Help.hs +++ b/src/Client/View/Help.hs @@ -14,7 +14,7 @@ module Client.View.Help ( helpImageLines ) where -import Client.State (ClientState, clientConfig, clientFocus) +import Client.State (ClientState, clientConfig) import Client.Configuration (configMacros) import Client.Commands import Client.Commands.Interpolation From a839f2500cfb0ffab4c28d0018497a159126a3d5 Mon Sep 17 00:00:00 2001 From: Eric Mertens Date: Wed, 31 Jul 2024 14:11:52 -0700 Subject: [PATCH 2/2] Add tagmsg to palette map for configuration --- src/Client/Image/Palette.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Client/Image/Palette.hs b/src/Client/Image/Palette.hs index fe327996..6ead074c 100644 --- a/src/Client/Image/Palette.hs +++ b/src/Client/Image/Palette.hs @@ -203,4 +203,5 @@ paletteMap = , ("part" , Lens palPart) , ("user-change" , Lens palUsrChg) , ("ignore" , Lens palIgnore) + , ("tagmsg" , Lens palTagmsg) ]