master 1d9a8884db 1/4: Have rcirc handle bridge bots

[Philip Kaludercic]

branch: master
commit 1d9a8884db63d430c96ce53e3d24c278dd8dbd8c
Author: Philip Kaludercic <philip@icterid>
Commit: Philip Kaludercic <philipk@posteo.net>

    Have rcirc handle bridge bots
    
    * doc/misc/rcirc.texi (Dealing with Bridge Bots): Document new feature.
    * etc/NEWS: Mention the new feature.
    * lisp/net/rcirc.el (rcirc-markup-text-functions): Add new markup function
    (rcirc-pseudo-nicks): Add new local variable.
    (rcirc-channel-nicks): Use 'rcirc-pseudo-nicks' for nick completion.
    (rcirc-bridge-bot-alist): Add new user option.
    (rcirc-bridged-nick): Add new face.
    (rcirc-markup-bridge-bots): Add new function.
---
 doc/misc/rcirc.texi |  41 +++++++++++++++++++++
 etc/NEWS            |  16 ++++++++
 lisp/net/rcirc.el   | 104 +++++++++++++++++++++++++++++++++++++++++++++-------
 3 files changed, 147 insertions(+), 14 deletions(-)

diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi
index 8c798d6c33..a028697847 100644
--- a/doc/misc/rcirc.texi
+++ b/doc/misc/rcirc.texi
@@ -859,6 +859,7 @@ Here are some examples of stuff you can do to configure 
@code{rcirc}.
 * Changing the time stamp format::
 * Defining a new command::
 * Using rcirc with bouncers::
+* Dealing with Bridge Bots::
 @end menu
 
 @node Skipping /away messages using handlers
@@ -992,6 +993,46 @@ displayed. A simple configuration to fix the above example 
might be:
       rcirc-channel-filter #'local/rcirc-soju-suffix)
 @end smallexample
 
+@node Dealing with Bridge Bots
+@section Dealing with Bridge Bots
+@cindex bridge
+
+It is increasingly common for IRC channels to be ``bridged'' onto
+other networks such as XMPP, Matrix, etc.  Sometimes the software does
+a good job at mapping each non-IRC user into an IRC user, but more
+often than not it doesn't.  In that case you might receive a message
+like:
+
+@example
+@verbatim
+09:47 <bridge> <john> I am not on IRC
+@end verbatim
+@end example
+
+where @samp{bridge} is a bot responsible for sending messages back and
+forth between networks, and @samp{john} is the user name of someone on
+a different network.  Note that the bot indicates this within the
+message (@verb{|<john> I am not on IRC|}) that appears in your chat
+buffer.
+
+@vindex rcirc-bridge-bot-alist
+If this annoys you, the user option @code{rcirc-bridge-bot-alist} may
+be of use.  It consists of descriptions of what users are these kinds
+of ``bridge bots'' and how they format their messages.  To handle the
+above example, we might set the user option to:
+
+@example
+(setopt rcirc-bridge-bot-alist
+        '(("bridge" . "<\\(.+?\\)>[[:space:]]+")))
+@end example
+
+If there is an entry for the current user, @code{rcirc} will take the
+associated regular expression and try to find a match in the message
+string.  If it manages to find anything, the matching expression is
+deleted from the message.  The regular expression must contain at
+least one group that will match the user name of the bridged message.
+This will then be used to replace the username of the bridge bot.
+
 @node GNU Free Documentation License
 @appendix GNU Free Documentation License
 @include doclicense.texi
diff --git a/etc/NEWS b/etc/NEWS
index 9b4238eea7..5e34f43179 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1060,6 +1060,22 @@ Rcirc will use the default 'completion-at-point' 
mechanism.  The
 conventional IRC behavior of completing by cycling through the
 available options can be restored by enabling this option.
 
++++
+*** New user option 'rcirc-bridge-bot-alist'.
+If you are in a channel where a bot is responsible for bridging
+between networks, you can use this variable to make these messages
+appear more native.  For example you might set the option to:
+
+    (setq rcirc-bridge-bot-alist '(("bridge" . "{\\(.+?\\)}[[:space:]]+")))
+
+for messages like
+
+    09:47 <bridge> {john} I am not on IRC
+
+to be reformatted into
+
+    09:47 <john> I am not on IRC
+
 ** Imenu
 
 +++
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index abb67da95f..5e48b3c70f 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -1925,7 +1925,8 @@ PROCESS is the process object for the current connection."
     rcirc-markup-my-nick
     rcirc-markup-urls
     rcirc-markup-keywords
-    rcirc-markup-bright-nicks)
+    rcirc-markup-bright-nicks
+    rcirc-markup-bridge-bots)
   "List of functions used to manipulate text before it is printed.
 
 Each function takes two arguments, SENDER, and RESPONSE.  The
@@ -2220,24 +2221,27 @@ PROCESS is the process object for the current 
connection."
           (puthash nick newchans rcirc-nick-table)
         (remhash nick rcirc-nick-table)))))
 
+(defvar rcirc-pseudo-nicks)
 (defun rcirc-channel-nicks (process target)
   "Return the list of nicks associated with TARGET sorted by last activity.
 PROCESS is the process object for the current connection."
   (when target
     (if (rcirc-channel-p target)
-        (with-rcirc-process-buffer process
-          (let (nicks)
-            (maphash
-             (lambda (k v)
-               (let ((record (assoc-string target v t)))
-                 (if record
-                     (setq nicks (cons (cons k (cdr record)) nicks)))))
-             rcirc-nick-table)
-            (mapcar (lambda (x) (car x))
-                    (sort nicks (lambda (x y)
-                                  (let ((lx (or (cdr x) 0))
-                                        (ly (or (cdr y) 0)))
-                                    (< ly lx)))))))
+        (let ((pseudo-nicks (mapcar #'list rcirc-pseudo-nicks)))
+          (with-rcirc-process-buffer process
+            (let (nicks)
+              (maphash
+               (lambda (k v)
+                 (let ((record (assoc-string target v t)))
+                   (if record
+                       (setq nicks (cons (cons k (cdr record)) nicks)))))
+               rcirc-nick-table)
+              (mapcar (lambda (x) (car x))
+                      (sort (nconc pseudo-nicks nicks)
+                            (lambda (x y)
+                              (let ((lx (or (cdr x) 0))
+                                    (ly (or (cdr y) 0)))
+                                (< ly lx))))))))
       (list target))))
 
 (defun rcirc-ignore-update-automatic (nick)
@@ -2911,6 +2915,78 @@ If ARG is given, opens the URL in a new browser window."
     (insert (rcirc-facify (format-time-string rcirc-time-format time)
                           'rcirc-timestamp))))
 
+(defvar-local rcirc-pseudo-nicks '()
+  "List of virtual nicks detected in a channel.
+These are collected by `rcirc-markup-bridge-bots' and don't
+constitute actual users in the current channel.  Usually these
+are bridged via a some bot as described in
+`rcirc-bridge-bot-alist'.")
+
+(defcustom rcirc-bridge-bot-alist '()
+  "Alist for handling bouncers by `rcirc-markup-bridge-bots'.
+Each entry has the form (NAME . REGEXP), where NAME is the user
+name of a bouncer and REGEXP is a pattern used to match the
+message.  The matching part of the message will be stripped from
+the message, and the first match group will replace the user name
+of the bot.  Any matched name will noted and used in some cases
+for nick completion."
+  :type '(alist :key-type (string :tag "Bot name")
+                :value-type regexp)
+  :version "29.1")
+
+(defface rcirc-bridged-nick
+  '((((class color) (min-colors 88) (background light)) :background 
"SlateGray1")
+    (((class color) (min-colors 88) (background dark))  :background 
"DarkSlateGray4")
+    (((class color) (min-colors 16) (background light)) :background 
"LightBlue")
+    (((class color) (min-colors 16) (background dark))  :background 
"DarkSlateGray")
+    (t :background "blue"))
+  "Face used for pseudo-nick ."
+  :version "29.1")
+
+(defun rcirc-markup-bridge-bots (sender response)
+  "Detect and reformat bridged messages to appear more natural.
+The user option `rcirc-bridge-bot-alist' specified what SENDER to
+handle.  This function only operates on direct messages (as
+indicated by RESPONSE)."
+  (catch 'quit
+    (atomic-change-group
+      (save-match-data
+        (when-let* (((string= response "PRIVMSG"))
+                    (regexp (alist-get sender rcirc-bridge-bot-alist
+                                       nil nil #'string=))
+                    ((search-forward-regexp regexp nil t))
+                    (nick (match-string-no-properties 1)))
+          (replace-match "")            ;delete the bot string
+          (unless (member nick rcirc-pseudo-nicks)
+            (push nick rcirc-pseudo-nicks))
+          (goto-char (point-min))
+          (let ((fmt (alist-get "PRIVMSG" rcirc-response-formats
+                                nil nil #'string=))
+                (hl-face (cond ((member sender rcirc-bright-nicks)
+                                'rcirc-bright-nick)
+                               ((member sender rcirc-dim-nicks)
+                                'rcirc-dim-nick)
+                               (t 'rcirc-other-nick)))
+                hl-username-p)
+            (when (string-match (rx (* "%%") "%" (group (or ?N ?n))) fmt)
+              (when (string= (match-string 1 fmt) "N")
+                (setq hl-username-p t))
+              (search-forward-regexp
+               (format-spec
+                (alist-get "PRIVMSG" rcirc-response-formats
+                           nil nil #'string=)
+                `((?m . "") (?r . "") (?t . "") (?f . "")
+                  (?N . ,(rx (group (+? nonl))))
+                  (?n . ,(rx (group (+? nonl))))))
+               nil t)
+              (replace-match
+               (propertize
+                nick
+                'help-echo (format "Message bridged via %s" sender)
+                'face `(,@(and hl-username-p (list hl-face))
+                        rcirc-bridged-nick))
+               nil t nil 1))))))))
+
 (defun rcirc-markup-attributes (_sender _response)
   "Highlight IRC markup, indicated by ASCII control codes."
   (while (re-search-forward