diff options
| author | F. Jason Park | 2023-04-28 06:34:09 -0700 |
|---|---|---|
| committer | F. Jason Park | 2023-05-05 17:18:01 -0700 |
| commit | ba44b4818446afdda4ff04c92d4ea34803fbc9db (patch) | |
| tree | 93793c2693536e5748d51168da8780d4c04ba7d5 | |
| parent | d141f7149b67daa93ac13420ee5edf4b0cbbf011 (diff) | |
| download | emacs-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.el | 4 | ||||
| -rw-r--r-- | lisp/erc/erc-button.el | 81 | ||||
| -rw-r--r-- | 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 @@ | |||
| 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) | 355 | Called 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. | 357 | DOWNCASED-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))) | 361 | Expect DOWNCASED to be the downcased nickname, NUH to be a triple |
| 362 | (puthash downcased user erc-button--phantom-users) | 362 | of (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. |
| 370 | Expect to be used by module setup code for creating placeholder | 379 | Expect to be used by module setup code for creating placeholder |
| 371 | users on the fly during history playback. Treat an unknown | 380 | users on the fly during history playback. Treat an unknown |
| 372 | PRIVMSG speaker, like <bob>, as if they were present in a 353 and | 381 | \"PRIVMSG\" speaker, like \"<bob>\", as if they previously |
| 373 | are thus a member of the channel. However, don't bother creating | 382 | appeared in a prior \"353\" message and are thus a known member |
| 374 | an actual `erc-channel-user' object because their status prefix | 383 | of the channel. However, don't bother creating an actual |
| 375 | is unknown. Instead, just spoof an `erc-server-user' by applying | 384 | `erc-channel-user' object because their status prefix is unknown. |
| 376 | early (outer), args-filtering advice wrapping | 385 | Instead, 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 |
| 387 | retrieve 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. | ||
| 4998 | Must return either nil or a cons of an `erc-server-user' and a | ||
| 4999 | possibly nil `erc-channel-user' for formatting a server user's | ||
| 5000 | nick. Called in the appropriate buffer with the downcased nick, | ||
| 5001 | the 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 "*" "<") "-")) |