master ba44b481844 14/14: Add interface for finding users in erc-server-PRIVMSG

[F. Jason Park]

branch: master
commit ba44b4818446afdda4ff04c92d4ea34803fbc9db
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    Add interface for finding users in erc-server-PRIVMSG
    
    * lisp/erc/erc-backend.el (erc-server-PRIVMSG): Call new hook
    `erc--user-from-nick-function' for turning the sender's nick into a
    channel user, if any.
    * lisp/erc/erc-button.el (erc-button--add-phantom-speaker): Redo
    completely using simplified API.
    (erc-button--fallback-user-function): Add internal function-interface
    variable for finding an `erc-server-user' object when the usual places
    disappoint.
    (erc-button--get-phantom-user): Add new function, a getter for
    `erc-button--phantom-users'.
    (erc-button--phantom-users-mode): Replace advice subscription for
    `erc-button--modify-nick-function' with one for
    `erc-button--user-from-nick-function' and one for
    `erc-button--fallback-user-function'.
    (erc-button--get-user-from-speaker-naive): Remove unused function.
    (erc-button--add-nickname-buttons): Call
    `erc-button--fallback-user-function' when a user can't be found in
    `erc-server-users' or `erc-channel-users'.
    * lisp/erc/erc.el (erc--user-from-nick-function): New
    function-interface variable for determining an `erc-server-user'
    `erc-channel-user' pair from the sender's nick.
    (erc--examine-nick): Add new function to serve as default value for
    `erc--user-from-nick-function'.  (Bug#60933)
---
 lisp/erc/erc-backend.el |  4 ++-
 lisp/erc/erc-button.el  | 81 +++++++++++++++++++++++++------------------------
 lisp/erc/erc.el         | 10 ++++++
 3 files changed, 55 insertions(+), 40 deletions(-)

diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index bc8e603e10a..2de24e7cb25 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -102,6 +102,7 @@
 (require 'erc-common)
 
 (defvar erc--target)
+(defvar erc--user-from-nick-function)
 (defvar erc-channel-list)
 (defvar erc-channel-users)
 (defvar erc-default-nicks)
@@ -1912,7 +1913,8 @@ add things to `%s' instead."
             ;; at this point.
             (erc-update-channel-member (if privp nick tgt) nick nick
                                        privp nil nil nil nil nil host login 
nil nil t)
-            (let ((cdata (erc-get-channel-user nick)))
+            (let ((cdata (funcall erc--user-from-nick-function
+                                  (erc-downcase nick) sndr parsed)))
               (setq fnick (funcall erc-format-nick-function
                                    (car cdata) (cdr cdata))))))
         (cond
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index c7f6685c851..4307dc3b860 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -350,55 +350,56 @@ be updated at will.")
 
 (defvar-local erc-button--phantom-users nil)
 
-(defun erc-button--add-phantom-speaker (args)
-  "Maybe substitute fake `server-user' for speaker at point."
-  (pcase (car args)
-    ((and obj (cl-struct erc-button--nick bounds downcased (user 'nil)))
-     ;; Like `with-memoization' but don't cache when value is nil.
-     (when-let ((user (or (gethash downcased erc-button--phantom-users)
-                          (erc-button--get-user-from-speaker-naive
-                           (car bounds)))))
-       (cl-assert (null (erc-button--nick-data obj)))
-       (puthash downcased user erc-button--phantom-users)
-       (setf (erc-button--nick-data obj) (list (erc-server-user-nickname user))
-             (erc-button--nick-user obj) user))
-     (list obj))
-    (_ args)))
-
+(defvar erc-button--fallback-user-function #'ignore
+  "Function to determine `erc-server-user' if not found in the usual places.
+Called with DOWNCASED-NICK, NICK, and NICK-BOUNDS when
+`erc-button-add-nickname-buttons' cannot find a user object for
+DOWNCASED-NICK in `erc-channel-users' or `erc-server-users'.")
+
+(defun erc-button--add-phantom-speaker (downcased nuh _parsed)
+  "Stash fictitious `erc-server-user' while processing \"PRIVMSG\".
+Expect DOWNCASED to be the downcased nickname, NUH to be a triple
+of (NICK LOGIN HOST), and parsed to be an `erc-response' object."
+  (pcase-let* ((`(,nick ,login ,host) nuh)
+               (user (or (gethash downcased erc-button--phantom-users)
+                         (make-erc-server-user
+                          :nickname nick
+                          :host (and (not (string-empty-p host)) host)
+                          :login (and (not (string-empty-p login)) login)))))
+    (list (puthash downcased user erc-button--phantom-users))))
+
+(defun erc-button--get-phantom-user (down _word _bounds)
+  (gethash down erc-button--phantom-users))
+
+;; In the future, we'll most likely create temporary
+;; `erc-channel-users' tables during BATCH chathistory playback, thus
+;; obviating the need for this mode entirely.
 (define-minor-mode erc-button--phantom-users-mode
   "Minor mode to recognize unknown speakers.
 Expect to be used by module setup code for creating placeholder
 users on the fly during history playback.  Treat an unknown
-PRIVMSG speaker, like <bob>, as if they were present in a 353 and
-are thus a member of the channel.  However, don't bother creating
-an actual `erc-channel-user' object because their status prefix
-is unknown.  Instead, just spoof an `erc-server-user' by applying
-early (outer), args-filtering advice wrapping
-`erc-button--modify-nick-function'."
+\"PRIVMSG\" speaker, like \"<bob>\", as if they previously
+appeared in a prior \"353\" message and are thus a known member
+of the channel.  However, don't bother creating an actual
+`erc-channel-user' object because their status prefix is unknown.
+Instead, just spoof an `erc-server-user' and stash it during
+\"PRIVMSG\" handling via `erc--user-from-nick-function' and
+retrieve it during buttonizing via
+`erc-button--fallback-user-function'."
   :interactive nil
   (if erc-button--phantom-users-mode
       (progn
-        (add-function :filter-args (local 'erc-button--modify-nick-function)
-                      #'erc-button--add-phantom-speaker '((depth . -90)))
+        (add-function :after-until (local 'erc--user-from-nick-function)
+                      #'erc-button--add-phantom-speaker '((depth . -50)))
+        (add-function :after-until (local 'erc-button--fallback-user-function)
+                      #'erc-button--get-phantom-user '((depth . 50)))
         (setq erc-button--phantom-users (make-hash-table :test #'equal)))
-    (remove-function (local 'erc-button--modify-nick-function)
+    (remove-function (local 'erc--user-from-nick-function)
                      #'erc-button--add-phantom-speaker)
+    (remove-function (local 'erc-button--fallback-user-function)
+                     #'erc-button--get-phantom-user)
     (kill-local-variable 'erc-nicks--phantom-users)))
 
-;; FIXME replace this after making ERC account-aware.
-(defun erc-button--get-user-from-speaker-naive (point)
-  "Return `erc-server-user' object for nick at POINT."
-  (when-let*
-      (((eql ?< (char-before point)))
-       ((eq (get-text-property point 'font-lock-face) 'erc-nick-default-face))
-       (parsed (erc-get-parsed-vector point)))
-    (pcase-let* ((`(,nick ,login ,host)
-                  (erc-parse-user (erc-response.sender parsed))))
-      (make-erc-server-user
-       :nickname nick
-       :host (and (not (string-empty-p host)) host)
-       :login (and (not (string-empty-p login)) login)))))
-
 (defun erc-button-add-nickname-buttons (entry)
   "Search through the buffer for nicknames, and add buttons."
   (let ((form (nth 2 entry))
@@ -422,7 +423,9 @@ early (outer), args-filtering advice wrapping
                              (gethash down erc-channel-users)))
                  (user (or (and cuser (car cuser))
                            (and erc-server-users
-                                (gethash down erc-server-users))))
+                                (gethash down erc-server-users))
+                           (funcall erc-button--fallback-user-function
+                                    down word bounds)))
                  (data (list word)))
             (when (or (not (functionp form))
                       (and-let* ((user)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 72ec8134eab..dbf413bac74 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -4993,6 +4993,16 @@ and as second argument the event parsed as a vector."
   (and (erc-is-message-ctcp-p message)
        (not (string-match "^\C-aACTION.*\C-a$" message))))
 
+(defvar erc--user-from-nick-function #'erc--examine-nick
+  "Function to possibly consider unknown user.
+Must return either nil or a cons of an `erc-server-user' and a
+possibly nil `erc-channel-user' for formatting a server user's
+nick.  Called in the appropriate buffer with the downcased nick,
+the parsed NUH, and the original `erc-response' object.")
+
+(defun erc--examine-nick (downcased _nuh _parsed)
+  (and erc-channel-users (gethash downcased erc-channel-users)))
+
 (defun erc-format-privmessage (nick msg privp msgp)
   "Format a PRIVMSG in an insertable fashion."
   (let* ((mark-s (if msgp (if privp "*" "<") "-"))