From a8e8078b95fa3dfa0b37b88a4d3b94432ae75468 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 30 Jun 2023 23:42:01 -0700 Subject: [PATCH 2/4] [5.6] Simplify erc-button-add-nickname-buttons * lisp/erc/erc-button.el (erc-button--nick): Remove `face' slot which was set to `erc-button-face' by default. It's ignored when the button is a nick and thus completely useless. (erc-button-add-nickname-buttons): Rework and reflow for readability. Don't bind or set `erc-button' face because it's ignored when dealing with nicks. Don't return the value of face options when calling a `form' function because they can be nil in practice even though their Custom type specs do not say so. * lisp/erc/erc.el (erc--get-speaker-bounds): New helper function to retrieve bounds of a speaker label when present. (Bug#64301) --- lisp/erc/erc-button.el | 78 ++++++++++++++++++++---------------------- lisp/erc/erc.el | 10 ++++++ 2 files changed, 47 insertions(+), 41 deletions(-) diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 0c616a6026d..c30f7c10ca6 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -355,8 +355,6 @@ erc-button--nick ( cuser nil :type (or null erc-channel-user) ;; The CDR of a value from an `erc-channel-users' table. :documentation "A possibly nil `erc-channel-user'.") - ( face erc-button-face :type symbol - :documentation "Temp `erc-button-face' while buttonizing.") ( nickname-face erc-button-nickname-face :type symbol :documentation "Temp `erc-button-nickname-face' while buttonizing.") ( mouse-face erc-button-mouse-face :type symbol @@ -431,45 +429,43 @@ erc-button--phantom-users-mode (defun erc-button-add-nickname-buttons (entry) "Search through the buffer for nicknames, and add buttons." - (let ((form (nth 2 entry)) - (fun (nth 3 entry)) - (erc-button-buttonize-nicks (and erc-button-buttonize-nicks - erc-button--modify-nick-function)) - bounds word) - (when (and form (setq form (erc-button--extract-form form))) - (goto-char (point-min)) - (while (erc-forward-word) - (when (setq bounds (erc-bounds-of-word-at-point)) - (setq word (buffer-substring-no-properties - (car bounds) (cdr bounds))) - (let* ((erc-button-face erc-button-face) - (erc-button-mouse-face erc-button-mouse-face) - (erc-button-nickname-face erc-button-nickname-face) - (down (erc-downcase word)) - (cuser (and erc-channel-users - (gethash down erc-channel-users))) - (user (or (and cuser (car cuser)) - (and 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) - (obj (funcall form (make-erc-button--nick - :bounds bounds :data data - :downcased down :user user - :cuser (cdr cuser))))) - (setq bounds (erc-button--nick-bounds obj) - data (erc-button--nick-data obj) - erc-button-mouse-face - (erc-button--nick-mouse-face obj) - erc-button-nickname-face - (erc-button--nick-nickname-face obj) - erc-button-face - (erc-button--nick-face obj)))) - (erc-button-add-button (car bounds) (cdr bounds) - fun t data)))))))) + (when-let ((form (nth 2 entry)) + ;; Spoof `form' slot of default legacy `nicknames' entry + ;; so `erc-button--extract-form' sees a function value. + (form (let ((erc-button-buttonize-nicks + (and erc-button-buttonize-nicks + erc-button--modify-nick-function))) + (erc-button--extract-form form))) + (seen 0)) + (goto-char (point-min)) + (while-let + (((erc-forward-word)) + (bounds (or (and (= 1 (cl-incf seen)) (erc--get-speaker-bounds)) + (erc-bounds-of-word-at-point))) + (word (buffer-substring-no-properties (car bounds) (cdr bounds))) + (down (erc-downcase word))) + (let* ((erc-button-mouse-face erc-button-mouse-face) + (erc-button-nickname-face erc-button-nickname-face) + (cuser (and erc-channel-users (gethash down erc-channel-users))) + (user (or (and cuser (car cuser)) + (and 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) + (obj (funcall form (make-erc-button--nick + :bounds bounds :data data + :downcased down :user user + :cuser (cdr cuser))))) + (setq erc-button-mouse-face ; might be null + (erc-button--nick-mouse-face obj) + erc-button-nickname-face ; might be null + (erc-button--nick-nickname-face obj) + data (erc-button--nick-data obj) + bounds (erc-button--nick-bounds obj)))) + (erc-button-add-button (car bounds) (cdr bounds) (nth 3 entry) + 'nickp data)))))) (defun erc-button-add-buttons-1 (regexp entry) "Search through the buffer for matches to ENTRY and add buttons." diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index e23185934f7..06b88ade2a0 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -5025,6 +5025,16 @@ erc-is-message-ctcp-and-not-action-p (and (erc-is-message-ctcp-p message) (not (string-match "^\C-aACTION.*\C-a$" message)))) +(define-inline erc--get-speaker-bounds () + "Return the bounds of `erc-speaker' property when present. +Assume buffer is narrowed to the confines of an inserted message." + (inline-quote + (and-let* + (((memq (get-text-property (point) 'erc-command) '(PRIVMSG NOTICE))) + (beg (or (and (get-text-property (point-min) 'erc-speaker) (point-min)) + (next-single-property-change (point-min) 'erc-speaker)))) + (cons beg (next-single-property-change beg 'erc-speaker))))) + (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 -- 2.41.0