master 4f3d036957a 04/15: Simplify erc-button-add-nickname-buttons

[F. Jason Park]

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

    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 useless and misleading.
    (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-common.el (erc--with-dependent-type-match): Add helper
    macro for Custom :type defs that incur warnings from `setopt' due to
    some missing dependency.  This occurs when specifying a :type of
    `face' instead of `symbol' and the option's default value includes
    faces from another library that hasn't been loaded.
    * lisp/erc/erc.el (erc--get-speaker-bounds): New helper function to
    retrieve bounds of a speaker label when present.
    * test/lisp/erc/erc-tests.el (erc--with-dependent-type-match): Add
    test.  (Bug#64301)
---
 lisp/erc/erc-button.el     | 78 ++++++++++++++++++++++------------------------
 lisp/erc/erc-common.el     |  9 ++++++
 lisp/erc/erc.el            | 10 ++++++
 test/lisp/erc/erc-tests.el |  9 ++++++
 4 files changed, 65 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 @@ specified by `erc-button-alist'."
   ( 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 @@ retrieve it during buttonizing via
 
 (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-common.el b/lisp/erc/erc-common.el
index f152a1a32d9..7bd549abfc1 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -465,6 +465,15 @@ Use the CASEMAPPING ISUPPORT parameter to determine the 
style."
     (inline-quote (erc-with-server-buffer
                     (gethash (erc-downcase ,nick) erc-server-users)))))
 
+(defmacro erc--with-dependent-type-match (type &rest features)
+  "Massage Custom :type TYPE with :match function that pre-loads FEATURES."
+  `(backquote (,(car type)
+               :match
+               ,(list '\, `(lambda (w v)
+                             ,@(mapcar (lambda (ft) `(require ',ft)) features)
+                             (,(widget-get (widget-convert type) :match) w v)))
+               ,@(cdr type))))
+
 (provide 'erc-common)
 
 ;;; erc-common.el ends here
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 7693947873e..6c3dc82b133 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -5073,6 +5073,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))))
 
+(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
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 449b8e0df42..8d63936b7c2 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -129,6 +129,15 @@
 
     (advice-remove 'buffer-local-value 'erc-with-server-buffer)))
 
+(ert-deftest erc--with-dependent-type-match ()
+  (should (equal (macroexpand-1
+                  '(erc--with-dependent-type-match (repeat face) erc-match))
+                 '(backquote
+                   (repeat :match ,(lambda (w v)
+                                     (require 'erc-match)
+                                     (widget-editable-list-match w v))
+                           face)))))
+
 (defun erc-tests--send-prep ()
   ;; Caller should probably shadow `erc-insert-modify-hook' or
   ;; populate user tables for erc-button.