From 63440ff3f23ef6c3d67fea598c748723ee5f32ac Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 29 Apr 2023 08:18:09 -0700 Subject: [PATCH 0/3] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (3): [5.6] Revise FORM-as-function interface in erc-button-alist [5.6] Improve erc-button--modify-nick-function interface [5.6] Use getter for finding users in erc-server-PRIVMSG lisp/erc/erc-backend.el | 4 +- lisp/erc/erc-button.el | 240 +++++++++++++++++------------- lisp/erc/erc.el | 39 ++++- test/lisp/erc/erc-button-tests.el | 106 +++++++++++++ 4 files changed, 280 insertions(+), 109 deletions(-) Interdiff: diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 4a394a10d44..f52cc1aaeaf 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-auto-query) (defvar erc-channel-list) (defvar erc-channel-users) @@ -1881,7 +1882,8 @@ define-erc-response-handler ;; 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 4829e8b7be2..638a2b20239 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -353,55 +353,56 @@ erc-button--modify-nick-function (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 , 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 \"\", 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)) @@ -425,10 +426,13 @@ erc-button-add-nickname-buttons (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* ((obj (funcall form (make-erc-button--nick + (and-let* ((user) + (obj (funcall form (make-erc-button--nick :bounds bounds :data data :downcased down :user user :cuser (cdr cuser))))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 071bef649b3..56f36a758b8 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -4947,20 +4947,45 @@ erc-is-message-ctcp-and-not-action-p (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))) + +(defvar erc--format-speaker-functions nil + "Abnormal hook for formatting the speaker of a PRIVMSG or NOTICE. +Called in a temp buffer narrowed to the nick and its surrounding +adornments, typically angle brackets. Called with two args, BEG +and END, indicating the bounds of the nick portion, which will +already have a `font-lock-face' applied.") + (defun erc-format-privmessage (nick msg privp msgp) "Format a PRIVMSG in an insertable fashion." (let* ((mark-s (if msgp (if privp "*" "<") "-")) (mark-e (if msgp (if privp "*" ">") "-")) - (str (format "%s%s%s %s" mark-s nick mark-e msg)) (nick-face (if privp 'erc-nick-msg-face 'erc-nick-default-face)) (msg-face (if privp 'erc-direct-msg-face 'erc-default-face))) ;; add text properties to text before the nick, the nick and after the nick - (erc-put-text-property 0 (length mark-s) 'font-lock-face msg-face str) - (erc-put-text-property (length mark-s) (+ (length mark-s) (length nick)) - 'font-lock-face nick-face str) - (erc-put-text-property (+ (length mark-s) (length nick)) (length str) - 'font-lock-face msg-face str) - str)) + (with-temp-buffer + (insert mark-s) ; pretend `mark-s' and `mark-e' might be > length 1 + (let ((beg (point)) end rest) + (insert nick) + (setq end (point)) + (insert mark-e) + (setq rest (point)) + ;; Insert before hook so members can widen to see entire msg. + (insert " " msg) + (put-text-property 1 (point) 'font-lock-face msg-face) + (put-text-property beg end 'font-lock-face nick-face) + (save-restriction + (narrow-to-region 1 rest) + (run-hook-with-args 'erc--format-speaker-functions beg end)) + (buffer-string))))) (defcustom erc-format-nick-function 'erc-format-nick "Function to format a nickname for message display." -- 2.40.0