aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorF. Jason Park2023-04-28 06:34:09 -0700
committerF. Jason Park2023-05-05 17:18:01 -0700
commitba44b4818446afdda4ff04c92d4ea34803fbc9db (patch)
tree93793c2693536e5748d51168da8780d4c04ba7d5
parentd141f7149b67daa93ac13420ee5edf4b0cbbf011 (diff)
downloademacs-ba44b4818446afdda4ff04c92d4ea34803fbc9db.tar.gz
emacs-ba44b4818446afdda4ff04c92d4ea34803fbc9db.zip
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)
-rw-r--r--lisp/erc/erc-backend.el4
-rw-r--r--lisp/erc/erc-button.el81
-rw-r--r--lisp/erc/erc.el10
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 @@
102(require 'erc-common) 102(require 'erc-common)
103 103
104(defvar erc--target) 104(defvar erc--target)
105(defvar erc--user-from-nick-function)
105(defvar erc-channel-list) 106(defvar erc-channel-list)
106(defvar erc-channel-users) 107(defvar erc-channel-users)
107(defvar erc-default-nicks) 108(defvar erc-default-nicks)
@@ -1912,7 +1913,8 @@ add things to `%s' instead."
1912 ;; at this point. 1913 ;; at this point.
1913 (erc-update-channel-member (if privp nick tgt) nick nick 1914 (erc-update-channel-member (if privp nick tgt) nick nick
1914 privp nil nil nil nil nil host login nil nil t) 1915 privp nil nil nil nil nil host login nil nil t)
1915 (let ((cdata (erc-get-channel-user nick))) 1916 (let ((cdata (funcall erc--user-from-nick-function
1917 (erc-downcase nick) sndr parsed)))
1916 (setq fnick (funcall erc-format-nick-function 1918 (setq fnick (funcall erc-format-nick-function
1917 (car cdata) (cdr cdata)))))) 1919 (car cdata) (cdr cdata))))))
1918 (cond 1920 (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.")
350 350
351(defvar-local erc-button--phantom-users nil) 351(defvar-local erc-button--phantom-users nil)
352 352
353(defun erc-button--add-phantom-speaker (args) 353(defvar erc-button--fallback-user-function #'ignore
354 "Maybe substitute fake `server-user' for speaker at point." 354 "Function to determine `erc-server-user' if not found in the usual places.
355 (pcase (car args) 355Called with DOWNCASED-NICK, NICK, and NICK-BOUNDS when
356 ((and obj (cl-struct erc-button--nick bounds downcased (user 'nil))) 356`erc-button-add-nickname-buttons' cannot find a user object for
357 ;; Like `with-memoization' but don't cache when value is nil. 357DOWNCASED-NICK in `erc-channel-users' or `erc-server-users'.")
358 (when-let ((user (or (gethash downcased erc-button--phantom-users) 358
359 (erc-button--get-user-from-speaker-naive 359(defun erc-button--add-phantom-speaker (downcased nuh _parsed)
360 (car bounds))))) 360 "Stash fictitious `erc-server-user' while processing \"PRIVMSG\".
361 (cl-assert (null (erc-button--nick-data obj))) 361Expect DOWNCASED to be the downcased nickname, NUH to be a triple
362 (puthash downcased user erc-button--phantom-users) 362of (NICK LOGIN HOST), and parsed to be an `erc-response' object."
363 (setf (erc-button--nick-data obj) (list (erc-server-user-nickname user)) 363 (pcase-let* ((`(,nick ,login ,host) nuh)
364 (erc-button--nick-user obj) user)) 364 (user (or (gethash downcased erc-button--phantom-users)
365 (list obj)) 365 (make-erc-server-user
366 (_ args))) 366 :nickname nick
367 367 :host (and (not (string-empty-p host)) host)
368 :login (and (not (string-empty-p login)) login)))))
369 (list (puthash downcased user erc-button--phantom-users))))
370
371(defun erc-button--get-phantom-user (down _word _bounds)
372 (gethash down erc-button--phantom-users))
373
374;; In the future, we'll most likely create temporary
375;; `erc-channel-users' tables during BATCH chathistory playback, thus
376;; obviating the need for this mode entirely.
368(define-minor-mode erc-button--phantom-users-mode 377(define-minor-mode erc-button--phantom-users-mode
369 "Minor mode to recognize unknown speakers. 378 "Minor mode to recognize unknown speakers.
370Expect to be used by module setup code for creating placeholder 379Expect to be used by module setup code for creating placeholder
371users on the fly during history playback. Treat an unknown 380users on the fly during history playback. Treat an unknown
372PRIVMSG speaker, like <bob>, as if they were present in a 353 and 381\"PRIVMSG\" speaker, like \"<bob>\", as if they previously
373are thus a member of the channel. However, don't bother creating 382appeared in a prior \"353\" message and are thus a known member
374an actual `erc-channel-user' object because their status prefix 383of the channel. However, don't bother creating an actual
375is unknown. Instead, just spoof an `erc-server-user' by applying 384`erc-channel-user' object because their status prefix is unknown.
376early (outer), args-filtering advice wrapping 385Instead, just spoof an `erc-server-user' and stash it during
377`erc-button--modify-nick-function'." 386\"PRIVMSG\" handling via `erc--user-from-nick-function' and
387retrieve it during buttonizing via
388`erc-button--fallback-user-function'."
378 :interactive nil 389 :interactive nil
379 (if erc-button--phantom-users-mode 390 (if erc-button--phantom-users-mode
380 (progn 391 (progn
381 (add-function :filter-args (local 'erc-button--modify-nick-function) 392 (add-function :after-until (local 'erc--user-from-nick-function)
382 #'erc-button--add-phantom-speaker '((depth . -90))) 393 #'erc-button--add-phantom-speaker '((depth . -50)))
394 (add-function :after-until (local 'erc-button--fallback-user-function)
395 #'erc-button--get-phantom-user '((depth . 50)))
383 (setq erc-button--phantom-users (make-hash-table :test #'equal))) 396 (setq erc-button--phantom-users (make-hash-table :test #'equal)))
384 (remove-function (local 'erc-button--modify-nick-function) 397 (remove-function (local 'erc--user-from-nick-function)
385 #'erc-button--add-phantom-speaker) 398 #'erc-button--add-phantom-speaker)
399 (remove-function (local 'erc-button--fallback-user-function)
400 #'erc-button--get-phantom-user)
386 (kill-local-variable 'erc-nicks--phantom-users))) 401 (kill-local-variable 'erc-nicks--phantom-users)))
387 402
388;; FIXME replace this after making ERC account-aware.
389(defun erc-button--get-user-from-speaker-naive (point)
390 "Return `erc-server-user' object for nick at POINT."
391 (when-let*
392 (((eql ?< (char-before point)))
393 ((eq (get-text-property point 'font-lock-face) 'erc-nick-default-face))
394 (parsed (erc-get-parsed-vector point)))
395 (pcase-let* ((`(,nick ,login ,host)
396 (erc-parse-user (erc-response.sender parsed))))
397 (make-erc-server-user
398 :nickname nick
399 :host (and (not (string-empty-p host)) host)
400 :login (and (not (string-empty-p login)) login)))))
401
402(defun erc-button-add-nickname-buttons (entry) 403(defun erc-button-add-nickname-buttons (entry)
403 "Search through the buffer for nicknames, and add buttons." 404 "Search through the buffer for nicknames, and add buttons."
404 (let ((form (nth 2 entry)) 405 (let ((form (nth 2 entry))
@@ -422,7 +423,9 @@ early (outer), args-filtering advice wrapping
422 (gethash down erc-channel-users))) 423 (gethash down erc-channel-users)))
423 (user (or (and cuser (car cuser)) 424 (user (or (and cuser (car cuser))
424 (and erc-server-users 425 (and erc-server-users
425 (gethash down erc-server-users)))) 426 (gethash down erc-server-users))
427 (funcall erc-button--fallback-user-function
428 down word bounds)))
426 (data (list word))) 429 (data (list word)))
427 (when (or (not (functionp form)) 430 (when (or (not (functionp form))
428 (and-let* ((user) 431 (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."
4993 (and (erc-is-message-ctcp-p message) 4993 (and (erc-is-message-ctcp-p message)
4994 (not (string-match "^\C-aACTION.*\C-a$" message)))) 4994 (not (string-match "^\C-aACTION.*\C-a$" message))))
4995 4995
4996(defvar erc--user-from-nick-function #'erc--examine-nick
4997 "Function to possibly consider unknown user.
4998Must return either nil or a cons of an `erc-server-user' and a
4999possibly nil `erc-channel-user' for formatting a server user's
5000nick. Called in the appropriate buffer with the downcased nick,
5001the parsed NUH, and the original `erc-response' object.")
5002
5003(defun erc--examine-nick (downcased _nuh _parsed)
5004 (and erc-channel-users (gethash downcased erc-channel-users)))
5005
4996(defun erc-format-privmessage (nick msg privp msgp) 5006(defun erc-format-privmessage (nick msg privp msgp)
4997 "Format a PRIVMSG in an insertable fashion." 5007 "Format a PRIVMSG in an insertable fashion."
4998 (let* ((mark-s (if msgp (if privp "*" "<") "-")) 5008 (let* ((mark-s (if msgp (if privp "*" "<") "-"))