unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: "J.P." <jp@neverwas.me>
To: 60933@debbugs.gnu.org
Cc: emacs-erc@gnu.org
Subject: bug#60933: 30.0.50; ERC >5.5: Make buttonizing more extensible
Date: Sat, 29 Apr 2023 08:56:06 -0700	[thread overview]
Message-ID: <87v8he65t5.fsf__14190.6096063153$1682783849$gmane$org@neverwas.me> (raw)
In-Reply-To: <877cu9qnyo.fsf@neverwas.me> (J. P.'s message of "Tue, 18 Apr 2023 07:11:59 -0700")

[-- Attachment #1: Type: text/plain, Size: 1574 bytes --]

"J.P." <jp@neverwas.me> writes:

> The same general thinking applies to the nicks-specific buttonizer as
> well, though it being intrinsically special and, for now, internal means
> we can take more liberties in inconveniencing its consumers (which are
> all built-in modules). Thus, I'm proposing we replace the slightly
> unwieldy set of positional params with a single passed-around struct,
> which members of the interface's "advice stack" can modify at will. See
> implementation for details.

Previously, consumers of the new nick-buttonizer interface were given a
look at every single word in a message. But they should only really care
about those with an associated `erc-server-user' object, meaning known
nicks. And while it's true that some might want to create these
associations on the fly, I think they're better off doing so earlier on,
both to help separate concerns and to skip the hassle of determining
whether a candidate is a speaker or a mention.

To that end, I've carved out a couple more access points to influence
how nick buttonizing happens. Both use the same pattern of "local advice
around a function-interface variable," which I've come to regard as the
most predictable and flexible for building new internal APIs. The first
lives in `erc-server-PRIVMSG' and integrates with the old
`erc-format-nick-function', which takes the user object it spits out.
The second runs right before the nick buttonizer but only as a fallback
when the usual means of finding an `erc-server-user' object from a
candidate fails. It's set to `ignore' by default.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v1-v2.diff --]
[-- Type: text/x-patch, Size: 10375 bytes --]

From 63440ff3f23ef6c3d67fea598c748723ee5f32ac Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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 <bob>, 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 \"<bob>\", 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


[-- Attachment #3: 0001-5.6-Revise-FORM-as-function-interface-in-erc-button-.patch --]
[-- Type: text/x-patch, Size: 13409 bytes --]

From 4542ad9bf3776ba92489acf226a70f314b0c1413 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sat, 15 Apr 2023 09:52:05 -0700
Subject: [PATCH 1/3] [5.6] Revise FORM-as-function interface in
 erc-button-alist

* lisp/erc/erc-button.el (erc-button-alist): Remove redundant "<URL:
foo>" entry, which adds nothing beyond highlighting the surrounding
bookends at the expense of doubling up on face properties for no
reason.  Revise the FORM-as-function interface by removing
the dynamic binding of face options and weird bounds-as-a-cons
parameter.  Instead, just treat any such function, when present, as a
replacement for `erc-button-add-button'.
(erc-button--maybe-warn-arbitrary-sexp): Make more robust by having it
handle all accepted FORM types other than booleans.
(erc-button-add-buttons-1): Rework to only check FORM field once.
(erc-button--substitute-command-keys-in-region,
erc-button--display-error-with-buttons): Rename former as latter and
change signature to conform to new `erc-button-add-buttons' interface.
(erc-button--display-error-notice-with-keys): Call renamed helper.
* test/lisp/erc/erc-button-tests.el (erc-button-alist--url,
erc-button-tests--form, erc-button-tests--some-var,
erc-button-tests--erc-button-alist--function-as-form,
erc-button-alist--function-as-form,
erc-button-tests--erc-button-alist--nil-form,
erc-button-alist---nil-form): Add tests and helpers.  (Bug#60933)
---
 lisp/erc/erc-button.el            |  91 +++++++++++++------------
 test/lisp/erc/erc-button-tests.el | 106 ++++++++++++++++++++++++++++++
 2 files changed, 151 insertions(+), 46 deletions(-)

diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index e2447deecde..7376c18ad4c 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -128,7 +128,6 @@ erc-button-alist
   ;; things hard to maintain.
   '((nicknames 0 erc-button-buttonize-nicks erc-nick-popup 0)
     (erc-button-url-regexp 0 t browse-url-button-open-url 0)
-    ("<URL: *\\([^<> ]+\\) *>" 0 t browse-url-button-open-url 1)
 ;;; ("(\\(\\([^~\n \t@][^\n \t@]*\\)@\\([a-zA-Z0-9.:-]+\\)\\)" 1 t finger 2 3)
     ;; emacs internal
     ("[`‘]\\([a-zA-Z][-a-zA-Z_0-9!*<=>+]+\\)['’]"
@@ -166,17 +165,14 @@ erc-button-alist
 BUTTON is the number of the regexp grouping actually matching the
   button.  This is ignored if REGEXP is `nicknames'.
 
-FORM is a Lisp symbol for a special variable whose value must be
-  true for the button to be added.  Alternatively, when REGEXP is
-  not `nicknames', FORM can be a function whose arguments are BEG
-  and END, the bounds of the button in the current buffer.  It's
-  expected to return a cons of (possibly identical) bounds or
-  nil, to deny.  For the extent of the call, all face options
-  defined for the button module are re-bound, shadowing
-  themselves, so the function is free to change their values.
-  When regexp is the special symbol `nicknames', FORM must be the
-  symbol `erc-button-buttonize-nicks'.  Specifying anything else
-  is deprecated.
+FORM is either a boolean or a special variable whose value must
+  be non-nil for the button to be added.  When REGEXP is the
+  special symbol `nicknames', FORM must be the symbol
+  `erc-button-buttonize-nicks'.  Anything else is deprecated.
+  For all other entries, FORM can also be a function to call in
+  place of `erc-button-add-button' with the exact same arguments.
+  When FORM is also a special variable, ERC disregards the
+  variable and calls the function.
 
 CALLBACK is the function to call when the user push this button.
   CALLBACK can also be a symbol.  Its variable value will be used
@@ -288,15 +284,18 @@ erc-button-add-buttons
                         entry)))))))))))
 
 (defun erc-button--maybe-warn-arbitrary-sexp (form)
-  (if (and (symbolp form) (special-variable-p form))
-      (symbol-value form)
-    (unless (get 'erc-button--maybe-warn-arbitrary-sexp 'warned-arbitrary-sexp)
-      (put 'erc-button--maybe-warn-arbitrary-sexp 'warned-arbitrary-sexp t)
-      (lwarn 'erc :warning
-             (concat "Arbitrary sexps for the third FORM"
-                     " slot of `erc-button-alist' entries"
-                     " have been deprecated.")))
-    (eval form t)))
+  (cl-assert (not (booleanp form))) ; covered by caller
+  ;; If a special-variable is also a function, favor the function.
+  (cond ((functionp form) form)
+        ((and (symbolp form) (special-variable-p form)) (symbol-value form))
+        (t (unless (get 'erc-button--maybe-warn-arbitrary-sexp
+                        'warned-arbitrary-sexp)
+             (put 'erc-button--maybe-warn-arbitrary-sexp
+                  'warned-arbitrary-sexp t)
+             (lwarn 'erc :warning (concat "Arbitrary sexps for the third FORM"
+                                          " slot of `erc-button-alist' entries"
+                                          " have been deprecated.")))
+           (eval form t))))
 
 (defun erc-button--check-nicknames-entry ()
   ;; This helper exists because the module is defined after its options.
@@ -412,22 +411,22 @@ erc-button-add-nickname-buttons
 (defun erc-button-add-buttons-1 (regexp entry)
   "Search through the buffer for matches to ENTRY and add buttons."
   (goto-char (point-min))
-  (while (re-search-forward regexp nil t)
-    (let ((start (match-beginning (nth 1 entry)))
-          (end (match-end (nth 1 entry)))
-          (form (nth 2 entry))
-          (fun (nth 3 entry))
-          (data (mapcar #'match-string-no-properties (nthcdr 4 entry))))
-      (when (or (eq t form)
-                (and (functionp form)
-                     (let* ((erc-button-face erc-button-face)
-                            (erc-button-mouse-face erc-button-mouse-face)
-                            (erc-button-nickname-face erc-button-nickname-face)
-                            (rv (funcall form start end)))
-                       (when rv
-                         (setq end (cdr rv) start (car rv)))))
-                (erc-button--maybe-warn-arbitrary-sexp form))
-        (erc-button-add-button start end fun nil data regexp)))))
+  (let (buttonizer)
+    (while
+        (and (re-search-forward regexp nil t)
+             (or buttonizer
+                 (setq buttonizer
+                       (and-let*
+                           ((raw-form (nth 2 entry))
+                            (res (or (eq t raw-form)
+                                     (erc-button--maybe-warn-arbitrary-sexp
+                                      raw-form))))
+                         (if (functionp res) res #'erc-button-add-button)))))
+      (let ((start (match-beginning (nth 1 entry)))
+            (end (match-end (nth 1 entry)))
+            (fun (nth 3 entry))
+            (data (mapcar #'match-string-no-properties (nthcdr 4 entry))))
+        (funcall buttonizer start end fun nil data regexp)))))
 
 (defun erc-button-remove-old-buttons ()
   "Remove all existing buttons.
@@ -682,15 +681,15 @@ erc-button-beats-to-time
     (message "@%s is %d:%02d local time"
              beats hours minutes)))
 
-(defun erc-button--substitute-command-keys-in-region (beg end)
+(defun erc-button--display-error-with-buttons
+    (from to fun nick-p &optional data regexp)
   "Replace command in region with keys and return new bounds"
-  (let* ((o (buffer-substring beg end))
-         (s (substitute-command-keys o)))
-    (unless (equal o s)
-      (setq erc-button-face nil))
-    (delete-region beg end)
-    (insert s))
-  (cons beg (point)))
+  (let* ((o (buffer-substring from to))
+         (s (substitute-command-keys o))
+         (erc-button-face (and (equal o s) erc-button-face)))
+    (delete-region from to)
+    (insert s)
+    (erc-button-add-button from (point) fun nick-p data regexp)))
 
 ;;;###autoload
 (defun erc-button--display-error-notice-with-keys (&optional parsed buffer
@@ -727,7 +726,7 @@ erc-button--display-error-notice-with-keys
                 erc-insert-post-hook))
          (erc-button-alist
           `((,(rx "\\[" (group (+ (not "]"))) "]") 0
-             erc-button--substitute-command-keys-in-region
+             erc-button--display-error-with-buttons
              erc-button-describe-symbol 1)
             ,@erc-button-alist)))
     (erc-display-message parsed '(notice error) (or buffer 'active) string)
diff --git a/test/lisp/erc/erc-button-tests.el b/test/lisp/erc/erc-button-tests.el
index ced08d117bc..6a6f6934389 100644
--- a/test/lisp/erc/erc-button-tests.el
+++ b/test/lisp/erc/erc-button-tests.el
@@ -23,6 +23,112 @@
 
 (require 'erc-button)
 
+(ert-deftest erc-button-alist--url ()
+  (setq erc-server-process
+        (start-process "sleep" (current-buffer) "sleep" "1"))
+  (set-process-query-on-exit-flag erc-server-process nil)
+  (with-current-buffer (erc--open-target "#chan")
+    (let ((verify
+           (lambda (p url)
+             (should (equal (get-text-property p 'erc-data) (list url)))
+             (should (equal (get-text-property p 'mouse-face) 'highlight))
+             (should (eq (get-text-property p 'font-lock-face) 'erc-button))
+             (should (eq (get-text-property p 'erc-callback)
+                         'browse-url-button-open-url)))))
+      (goto-char (point-min))
+
+      ;; Most common (unbracketed)
+      (erc-display-message nil nil (current-buffer)
+                           "Foo https://example.com bar.")
+      (search-forward "https")
+      (funcall verify (point) "https://example.com")
+
+      ;; The <URL: form> still works despite being removed in ERC 5.6.
+      (erc-display-message nil nil (current-buffer)
+                           "Foo <URL: https://gnu.org> bar.")
+      (search-forward "https")
+      (funcall verify (point) "https://gnu.org")
+
+      ;; Bracketed
+      (erc-display-message nil nil (current-buffer) "Foo <ftp://gnu.org> bar.")
+      (search-forward "ftp")
+      (funcall verify (point) "ftp://gnu.org"))
+
+    (when noninteractive
+      (kill-buffer))))
+
+(defvar erc-button-tests--form nil)
+(defvar erc-button-tests--some-var nil)
+
+(defun erc-button-tests--form (&rest rest)
+  (push rest erc-button-tests--form)
+  (apply #'erc-button-add-button rest))
+
+(defun erc-button-tests--erc-button-alist--function-as-form (func)
+  (setq erc-server-process
+        (start-process "sleep" (current-buffer) "sleep" "1"))
+  (set-process-query-on-exit-flag erc-server-process nil)
+
+  (with-current-buffer (erc--open-target "#chan")
+    (let* ((erc-button-tests--form nil)
+           (entry (list (rx "+1") 0 func #'ignore 0))
+           (erc-button-alist (cons entry erc-button-alist)))
+
+      (erc-display-message nil 'notice (current-buffer) "Foo bar baz")
+      (erc-display-message nil nil (current-buffer) "+1")
+      (erc-display-message nil 'notice (current-buffer) "Spam")
+      (should (equal (pop erc-button-tests--form)
+                     '(53 55 ignore nil ("+1") "\\+1")))
+      (should-not erc-button-tests--form)
+      (goto-char (point-min))
+      (search-forward "+")
+      (should (equal (get-text-property (point) 'erc-data) '("+1")))
+      (should (equal (get-text-property (point) 'mouse-face) 'highlight))
+      (should (eq (get-text-property (point) 'font-lock-face) 'erc-button))
+      (should (eq (get-text-property (point) 'erc-callback) 'ignore)))
+
+    (when noninteractive
+      (kill-buffer))))
+
+(ert-deftest erc-button-alist--function-as-form ()
+  (erc-button-tests--erc-button-alist--function-as-form
+   #'erc-button-tests--form)
+
+  (erc-button-tests--erc-button-alist--function-as-form
+   (symbol-function #'erc-button-tests--form))
+
+  (erc-button-tests--erc-button-alist--function-as-form
+   (lambda (&rest r) (push r erc-button-tests--form)
+     (apply #'erc-button-add-button r))))
+
+(defun erc-button-tests--erc-button-alist--nil-form (form)
+  (setq erc-server-process
+        (start-process "sleep" (current-buffer) "sleep" "1"))
+  (set-process-query-on-exit-flag erc-server-process nil)
+
+  (with-current-buffer (erc--open-target "#chan")
+    (let* ((erc-button-tests--form nil)
+           (entry (list (rx "+1") 0 form #'ignore 0))
+           (erc-button-alist (cons entry erc-button-alist)))
+
+      (erc-display-message nil 'notice (current-buffer) "Foo bar baz")
+      (erc-display-message nil nil (current-buffer) "+1")
+      (erc-display-message nil 'notice (current-buffer) "Spam")
+      (should-not erc-button-tests--form)
+      (goto-char (point-min))
+      (search-forward "+")
+      (should-not (get-text-property (point) 'erc-data))
+      (should-not (get-text-property (point) 'mouse-face))
+      (should-not (get-text-property (point) 'font-lock-face))
+      (should-not (get-text-property (point) 'erc-callback)))
+
+    (when noninteractive
+      (kill-buffer))))
+
+(ert-deftest erc-button-alist--nil-form ()
+  (erc-button-tests--erc-button-alist--nil-form nil)
+  (erc-button-tests--erc-button-alist--nil-form 'erc-button-tests--some-var))
+
 (defun erc-button-tests--insert-privmsg (speaker &rest msg-parts)
   (declare (indent 1))
   (let ((msg (erc-format-privmessage speaker
-- 
2.40.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6-Improve-erc-button-modify-nick-function-interfac.patch --]
[-- Type: text/x-patch, Size: 7664 bytes --]

From 9a3f8710e5aabd0975ea242142600a51bdcc9be7 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sat, 15 Apr 2023 09:52:05 -0700
Subject: [PATCH 2/3] [5.6] Improve erc-button--modify-nick-function interface

* lisp/erc/erc-button.el (erc-button--check-nicknames-entry): Remove
unused let binding.
(erc-button--nick): New struct.
(erc-button--preserve-bounds): Rework to expect `erc-button--nick'
object.
(erc-button--modify-nick-function): Reexplain interface base on
`erc-button--nick' object.
(erc-button--add-phantom-speaker): Redo to expect `erc-button--nick'
object.
(erc-button-add-nickname-buttons): Rework slightly to use
`erc-button--nick' when calling `erc-button--modify-nick-function'.
(Bug#60933)
---
 lisp/erc/erc-button.el | 92 +++++++++++++++++++++++++++++-------------
 1 file changed, 64 insertions(+), 28 deletions(-)

diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 7376c18ad4c..b427b72ee5d 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -299,16 +299,42 @@ erc-button--maybe-warn-arbitrary-sexp
 
 (defun erc-button--check-nicknames-entry ()
   ;; This helper exists because the module is defined after its options.
-  (when-let (((eq major-mode 'erc-mode))
-             (entry (alist-get 'nicknames erc-button-alist)))
-    (unless (eq 'erc-button-buttonize-nicks (nth 1 entry))
+  (when (eq major-mode 'erc-mode)
+    (unless (eq (nth 1 (alist-get 'nicknames erc-button-alist))
+                'erc-button-buttonize-nicks)
       (erc-button--display-error-notice-with-keys-and-warn
        "Values other than `erc-button-buttonize-nicks' in the third slot of "
        "the `nicknames' entry of `erc-button-alist' are deprecated."))))
 
-(defun erc-button--preserve-bounds (bounds _ server-user _)
-  "Return BOUNDS.\n\n(fn BOUNDS NICKNAME SERVER-USER CHANNEL-USER)"
-  (and server-user bounds))
+(cl-defstruct erc-button--nick
+  ;; Indicates the nick's position in the current message.  BEG is
+  ;; normally also point.
+  ( bounds nil :type cons
+    :documentation "A cons of (BEG . END).")
+  ;; NICK is the original, non-casemapped nickname and REST is a
+  ;; possibly empty list of opaque objects.  If non-nil, the entire
+  ;; cons should be mutated rather than replaced because it's used as
+  ;; a key in hash tables and text-property searches.
+  ( data nil :type (or null cons)
+    :documentation "A unique cons of (NICK . REST).")
+  ( downcased nil :type (or null string)
+    :documentation "The case-mapped nickname sans text properties.")
+  ;; Not necessarily present in `erc-server-users'.
+  ( user nil :type (or null erc-server-user)
+    :documentation "A possibly nil or spoofed `erc-server-user'.")
+  ;; The CDR of a value from an `erc-channel-users' table.
+  ( cuser nil :type (or null erc-channel-user)
+    :documentation "A possibly nil `erc-channel-user'.")
+  ( erc-button-face erc-button-face :type symbol
+    :documentation "Temp `erc-button-face' while buttonizing.")
+  ( erc-button-nickname-face erc-button-nickname-face :type symbol
+    :documentation "Temp `erc-button-nickname-face' while buttonizing.")
+  ( erc-button-mouse-face erc-button-mouse-face :type symbol
+    :documentation "Temp `erc-button-mouse-face' while buttonizing."))
+
+(defun erc-button--preserve-bounds (nick-object)
+  "Return NICK-OBJECT when its user slot is non-empty."
+  (and (erc-button--nick-user nick-object) nick-object))
 
 ;; This variable is intended to serve as a "core" to be wrapped by
 ;; (built-in) modules during setup.  It's unclear whether
@@ -319,29 +345,27 @@ erc-button--preserve-bounds
 
 (defvar erc-button--modify-nick-function #'erc-button--preserve-bounds
   "Function to possibly modify aspects of nick being buttonized.
-Called with four args: BOUNDS NICKNAME SERVER-USER CHANNEL-USER.
-BOUNDS is a cons of (BEG . END) marking the position of the nick
-in the current message, which occupies the whole of the narrowed
-buffer.  BEG is normally also point.  NICKNAME is a case-mapped
-string without text properties.  SERVER-USER and CHANNEL-USER are
-the nick's `erc-server-users' entry and its associated (though
-possibly nil) `erc-channel-user' object.  The function should
-return BOUNDS or a suitable replacement to indicate that
-buttonizing ought to proceed, and nil if it should be inhibited.")
+Called with one argument, an `erc-button--nick' object, or nil.
+The function should return the same (or similar) object when
+buttonizing ought to proceed and nil otherwise.  While running,
+all faces defined in `erc-button' are bound temporarily and can
+be updated at will.")
 
 (defvar-local erc-button--phantom-users nil)
 
 (defun erc-button--add-phantom-speaker (args)
   "Maybe substitute fake `server-user' for speaker at point."
-  (pcase args
-    (`(,bounds ,downcased-nick nil ,channel-user)
-     (list bounds downcased-nick
-           ;; Like `with-memoization' but don't cache when value is nil.
-           (or (gethash downcased-nick erc-button--phantom-users)
-               (and-let* ((user (erc-button--get-user-from-speaker-naive
-                                 (car bounds))))
-                 (puthash downcased-nick user erc-button--phantom-users)))
-           channel-user))
+  (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)))
 
 (define-minor-mode erc-button--phantom-users-mode
@@ -401,12 +425,24 @@ 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))))
+                 (data (list word)))
             (when (or (not (functionp form))
-                      (setq bounds
-                            (funcall form bounds down user (cdr cuser))))
+                      (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-erc-button-mouse-face obj)
+                              erc-button-nickname-face
+                              (erc-button--nick-erc-button-nickname-face obj)
+                              erc-button-face
+                              (erc-button--nick-erc-button-face obj))))
               (erc-button-add-button (car bounds) (cdr bounds)
-                                     fun t (list word)))))))))
+                                     fun t data))))))))
 
 (defun erc-button-add-buttons-1 (regexp entry)
   "Search through the buffer for matches to ENTRY and add buttons."
-- 
2.40.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.6-Use-getter-for-finding-users-in-erc-server-PRIVM.patch --]
[-- Type: text/x-patch, Size: 11347 bytes --]

From 63440ff3f23ef6c3d67fea598c748723ee5f32ac Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 28 Apr 2023 06:34:09 -0700
Subject: [PATCH 3/3] [5.6] Use getter 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'.
(erc--format-speaker-functions): Add new internal
hook to adjust formatted speaker of a private message.
(erc-format-privmessage): Run hook `erc--format-speaker-functions' in
temporary buffer narrowed to speaker's formatted nick.  This and the
hook will likely be removed unless an immediate use case arises.  In
the long term, this may be useful for offering alternate styling for
speaker names, e.g., other than "<bob>".  (Bug#60933)
---
 lisp/erc/erc-backend.el |  4 +-
 lisp/erc/erc-button.el  | 81 +++++++++++++++++++++--------------------
 lisp/erc/erc.el         | 39 ++++++++++++++++----
 3 files changed, 77 insertions(+), 47 deletions(-)

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 b427b72ee5d..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 <bob>, 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 \"<bob>\", 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,7 +426,9 @@ 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* ((user)
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


  parent reply	other threads:[~2023-04-29 15:56 UTC|newest]

Thread overview: 9+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2023-01-18 14:38 bug#60933: 30.0.50; ERC >5.5: Make buttonizing more extensible J.P.
2023-02-19 15:04 ` J.P.
2023-03-09 14:42 ` J.P.
     [not found] ` <87fsaekmv4.fsf@neverwas.me>
2023-04-18 14:11   ` J.P.
     [not found]   ` <877cu9qnyo.fsf@neverwas.me>
2023-04-29 15:56     ` J.P. [this message]
2023-05-23 13:35 ` J.P.
2023-06-02 14:07 ` J.P.
2023-09-13 14:09 ` J.P.
     [not found] ` <87wmwuyxjh.fsf@neverwas.me>
2023-09-19 13:28   ` J.P.

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to='87v8he65t5.fsf__14190.6096063153$1682783849$gmane$org@neverwas.me' \
    --to=jp@neverwas.me \
    --cc=60933@debbugs.gnu.org \
    --cc=emacs-erc@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).