master 0300db0ae50: Remove choice from erc-dangerous-host-highlight-type
"F. Jason Park" <[email protected]>
| Newsgroups | gmane.emacs.diffs |
|---|---|
| Message-ID | <[email protected]> |
branch: master commit 0300db0ae50a797c1d66d403084545c0e238af5f Author: F. Jason Park <[email protected]> Commit: F. Jason Park <[email protected]> Remove choice from erc-dangerous-host-highlight-type ;; * etc/ERC-NEWS: Revise wording from recent mechanical change. * lisp/erc/erc-match.el (erc-match--opt-pat-cache, erc-pals, erc-fools): Update doc. (erc-dangerous-host-highlight-type): Remove nonsensical `nick-or-mention' value introduced for ERC 5.7 and Emacs 32 via bug#73798. It doesn't make sense to highlight mentions of a dangerous host, only its associated nicknames, which ERC has no knowledge of. (erc-match--opt-pat-get): Apply `sxhash-equal' to input in order to protect keys from retroactive mutation. Otherwise, a user applying `setcar' to a cached `erc-fools' value could corrupt the cache. (erc-match-mention-beg-rx-sexp, erc-match-mention-any-rx-sexp): New variables to expose how ERC looks for "addressees" in a message body. (erc-match--opt-pat-make-addr-beg): Defer to `erc-match-mention-beg-rx-sexp' variable for regexp. (erc-match--opt-pat-make-addr-end, erc-match--opt-pat-make-addr-any): Rename former to latter and use `erc-match-mention-any-rx-sexp' for regexp. (erc-match--user-nuh-or-mention-p): Use updated function name. (erc-match-highlight-by-part): Use `match-data' to detect the "last thing searched" by the predicate. * test/lisp/erc/erc-match-tests.el (erc-match-message/fool/nick-or-mention): Remove test associated with nonexistent value `nick-or-mention' for option `erc-dangerous-host-highlight-type'. (erc-match--opt-pat-cache): Use updated function name, sort character alternatives in bracket expression, update format of expected output to include hashes. ;; (erc-match-tests--hl-type-nick) ;; (erc-match-message/fool/nick) ;; (erc-match-message/dangerous-host/nick/legacy) ;; (erc-match-tests--hl-type-message) ;; (erc-match-message/dangerous-host/message) ;; (erc-match-message/dangerous-host/message/legacy) ;; (erc-match-tests--hl-type-all) ;; (erc-match-message/fool/all) ;; (erc-match-message/dangerous-host/all/legacy) ;; (erc-match-tests--hl-type-nick-or-keyword) ;; (erc-match-tests--hl-type-keyword): Use realistic value for ;; option `erc-dangerous-hosts'. --- etc/ERC-NEWS | 2 +- lisp/erc/erc-match.el | 70 ++++++++++++++++++++++++++++++---------- test/lisp/erc/erc-match-tests.el | 45 ++++++++++++-------------- 3 files changed, 75 insertions(+), 42 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index c4926d2b8f0..928288508b7 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -34,7 +34,7 @@ skip messages from "fools" and those in untracked buffers. Option 'erc-desktop-notifications-ignored-when-focused' can spare users from being notified when interacting with the initiating buffer. -** Apply options in detail to specific connections or buffers. +** Apply options locally to specific connections or buffers. Based on an idea drafted nearly a quarter century ago by ERC's earliest contributors, the 'settings' module offers a ready-made method for binding arbitrary user options to various "scopes" of interest. It diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index c6675053e55..a9fc64b7ce4 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -66,7 +66,8 @@ highlighted." ;; This caches the result of applying `regexp-opt' analogs to the ;; regexp-based user options, mainly for history playback bursts. (defvar erc-match--opt-pat-cache nil - "Alist of (COMPUTE-FN . PAIRS) where PAIRS is an alist of (IN . OUT).") + "Alist of (COMPUTE-FN . PAIRS) where PAIRS is an alist of (IN . OUT). +IN is a hash of an input option's list value.") (defun erc-match--opt-pat-custom-set (sym val &optional _) "Assign VAL to SYM via `set'." @@ -78,12 +79,25 @@ highlighted." ;; Remaining customizations (defcustom erc-pals nil - "List of pals on IRC." + "List of regexps for messages involving \"pals\" on IRC. +ERC handles patterns for pals much the way it does for \"fools\" in +`erc-fools'. However, with pals, ERC only searches for \"mentions\" if +the corresponding highlight option, `erc-pal-highlight-type', is set to +`nick-or-mention'." :set #'erc-match--opt-pat-custom-set :type '(repeat regexp)) (defcustom erc-fools nil - "List of fools on IRC." + "List of regexp patterns matching \"fools\" on IRC. +ERC tests each pattern against a message's sender, also known as its +\"source\" or its \"NUH\", which normally looks like: nick!user@host. +ERC also looks for \"mentions\" in a message's body. To match an +initial addressee, it tries both \"pattern: \" and \"pattern, \". +Absent either, ERC scans the rest of the body for phrases like +\". pattern,\" and \", pattern!\", which may seem unintuitive. See +legacy function `erc-match-directed-at-fool-p' as well as the variables +`erc-match-mention-beg-rx-sexp' and `erc-match-mention-any-rx-sexp' for +particulars regarding this behavior and ways to possibly modify it." :set #'erc-match--opt-pat-custom-set :type '(repeat regexp)) @@ -200,11 +214,10 @@ Any other value disables keyword highlighting altogether." "Determines how to highlight messages by nicks from dangerous-hosts. Use option `erc-dangerous-hosts' to specify patterns. See `erc-pal-highlight-type' for a summary of possible values as well as -additional details common to categories like \\+`dangerous-host' that -normally match against a message's sender." +additional details common to options whose patterns ERC matches against +a message's sender." :type '(choice (const nil) (const nick) - (const nick-or-mention) (const message) (const all))) @@ -615,11 +628,30 @@ trailing newline." (defun erc-match--opt-pat-get (compute-fn input) "Retrieve cached results for computing INPUT with COMPUTE-FN." - (with-memoization (alist-get input (alist-get compute-fn - erc-match--opt-pat-cache nil t) + (with-memoization (alist-get (sxhash-equal input) + (alist-get compute-fn + erc-match--opt-pat-cache nil t) nil t) (funcall compute-fn input))) +(defvar erc-match-mention-beg-rx-sexp + '(: bow (group candidates) (| ?, ?:) ?\s) + "An `rx' sexp matching at the beginning of an inserted message body. +By default, it matches an addressee to which the message is directed. +ERC replaces the symbol `candidates' with a pattern combining all +members from relevant options, like `erc-fools'.") + +(defvar erc-match-mention-any-rx-sexp + '(: (syntax ?.) ?\s (group candidates) (syntax ?.)) + "An `rx' sexp matching anywhere in the message body. +By default, it matches the relevant option's value, such as that of +`erc-fools', if the combined regexp pattern appears as a phrase +surrounded by punctuation. Note that the purpose of this default +pattern is no longer known. It survives purely for the sake of +compatibility and may be replaced by something more obviously useful in +the future. See `erc-match-mention-beg-rx-sexp' for the meaning of +`candidates'.") + (defun erc-match--opt-pat-make (patterns) "Act like `regexp-opt' but for regexp PATTERNS, not fixed strings." (string-join patterns "\\|")) @@ -628,10 +660,12 @@ trailing newline." (mapconcat (lambda (w) (or (car-safe w) w)) patterns "\\|")) (defun erc-match--opt-pat-make-addr-beg (patterns) - (concat "\\<\\(" (erc-match--opt-pat-make patterns) "\\)[:,] ")) + (rx-let-eval `((candidates ,(erc-match--opt-pat-make patterns))) + (rx-to-string erc-match-mention-beg-rx-sexp 'no-group))) -(defun erc-match--opt-pat-make-addr-end (patterns) - (concat "\\s. \\(" (erc-match--opt-pat-make patterns) "\\)\\s.")) +(defun erc-match--opt-pat-make-addr-any (patterns) + (rx-let-eval `((candidates ,(erc-match--opt-pat-make patterns))) + (rx-to-string erc-match-mention-any-rx-sexp 'no-group))) (defun erc-match--current-nick-p (match) (re-search-forward (car (erc-match-traditional-data match)) nil t)) @@ -645,9 +679,11 @@ trailing newline." nil t))) (defun erc-match--user-nuh-or-mention-p (match) - "Return non-nil on matching \"NUH\" for MATCH object. + "Return non-nil if pattern in MATCH's data slot matches its sender. Also do so on mentions if the category is `fool' or the corresponding -\"part\" option is `nick-or-mention'." +\"highlight-type\" option is `nick-or-mention'. For mentions, match +against the inserted message in the narrowed buffer. Expect caller to +know that `match-data' may describe a buffer or a string match." (and-let* ((patterns (erc-match-traditional-data match))) (or (string-match (erc-match--opt-pat-get #'erc-match--opt-pat-make patterns) @@ -661,7 +697,7 @@ Also do so on mentions if the category is `fool' or the corresponding #'erc-match--opt-pat-make-addr-beg patterns)) (search-forward-regexp - (erc-match--opt-pat-get #'erc-match--opt-pat-make-addr-end + (erc-match--opt-pat-get #'erc-match--opt-pat-make-addr-any patterns) nil t)))))) @@ -713,9 +749,9 @@ Also do so on mentions if the category is `fool' or the corresponding (cl-defmethod erc-match-highlight-by-part ((match erc-match-traditional) (_ (eql nick-or-mention))) "Highlight MATCH's speaker tag nick of matching users or all mentions." - (cl-letf (((erc-match-body-beg match) - (or (erc-match-spkr-beg match) (point-min)))) - (erc-match-highlight-by-part match 'keyword))) + (if (bufferp (car (last (match-data 'integers)))) + (erc-match-highlight-by-part match 'keyword) + (erc-match-highlight-by-part match 'nick))) (defvar erc-match-highlight-matched nil "Matched `erc-match' instance in `erc-text-matched-hook'.") diff --git a/test/lisp/erc/erc-match-tests.el b/test/lisp/erc/erc-match-tests.el index 0bb347785c6..111c7f4ffd3 100644 --- a/test/lisp/erc/erc-match-tests.el +++ b/test/lisp/erc/erc-match-tests.el @@ -268,7 +268,7 @@ (erc-match-tests--perform (lambda () - (erc-tests-common-add-cmem "bob") + (erc-tests-common-add-cmem "bob" "gnu.org") (erc-tests-common-add-cmem "alice") ;; Change highlight type for match categories `keyword' and ;; `current-nick' to `nick'. @@ -344,7 +344,7 @@ (ert-deftest erc-match-message/dangerous-host/nick () (should (eq erc-dangerous-host-highlight-type 'nick)) - (let ((erc-dangerous-hosts (list "bob"))) + (let ((erc-dangerous-hosts (list "gnu\\.org"))) (erc-match-tests--hl-type-nick 'erc-dangerous-host-face))) (ert-deftest erc-match-message/pal/nick/legacy () @@ -365,7 +365,7 @@ (should (eq erc-dangerous-host-highlight-type 'nick)) (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete)) (let ((erc-match-use-legacy-logic-p t) - (erc-dangerous-hosts (list "bob"))) + (erc-dangerous-hosts (list "gnu\\.org"))) (erc-match-tests--hl-type-nick 'erc-dangerous-host-face)))) ;; Mentions are treated as keywords, even in the speaker portion. @@ -412,19 +412,13 @@ (erc-fools (list "bob"))) (erc-match-tests--hl-type-nick-or-mention 'erc-fool-face))) -(ert-deftest erc-match-message/dangerous-host/nick-or-mention () - (should (eq erc-dangerous-host-highlight-type 'nick)) - (let ((erc-dangerous-host-highlight-type 'nick-or-mention) - (erc-dangerous-hosts (list "bob"))) - (erc-match-tests--hl-type-nick-or-mention 'erc-dangerous-host-face))) - (defun erc-match-tests--hl-type-message (face) (should (eq erc-current-nick-highlight-type 'keyword)) (should (eq erc-keyword-highlight-type 'keyword)) (erc-match-tests--perform (lambda () - (erc-tests-common-add-cmem "bob") + (erc-tests-common-add-cmem "bob" "gnu.org") (erc-tests-common-add-cmem "alice") ;; Change highlight type for categories `keyword' and ;; `current-nick' to `message'. @@ -479,7 +473,7 @@ (ert-deftest erc-match-message/dangerous-host/message () (should (eq erc-dangerous-host-highlight-type 'nick)) - (let ((erc-dangerous-hosts (list "bob")) + (let ((erc-dangerous-hosts (list "gnu\\.org")) (erc-dangerous-host-highlight-type 'message)) (erc-match-tests--hl-type-message 'erc-dangerous-host-face))) @@ -503,7 +497,7 @@ (should (eq erc-dangerous-host-highlight-type 'nick)) (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete)) (let ((erc-match-use-legacy-logic-p t) - (erc-dangerous-hosts (list "bob")) + (erc-dangerous-hosts (list "gnu\\.org")) (erc-dangerous-host-highlight-type 'message)) (erc-match-tests--hl-type-message 'erc-dangerous-host-face)))) @@ -513,7 +507,7 @@ (erc-match-tests--perform (lambda () - (erc-tests-common-add-cmem "bob") + (erc-tests-common-add-cmem "bob" "gnu.org") (erc-tests-common-add-cmem "alice") ;; Change highlight type for categories `current-nick' and ;; `keyword' to `all'. @@ -568,7 +562,7 @@ (ert-deftest erc-match-message/dangerous-host/all () (should (eq erc-dangerous-host-highlight-type 'nick)) - (let ((erc-dangerous-hosts (list "bob")) + (let ((erc-dangerous-hosts (list "gnu\\.org")) (erc-dangerous-host-highlight-type 'all)) (erc-match-tests--hl-type-all 'erc-dangerous-host-face))) @@ -592,7 +586,7 @@ (should (eq erc-dangerous-host-highlight-type 'nick)) (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete)) (let ((erc-match-use-legacy-logic-p t) - (erc-dangerous-hosts (list "bob")) + (erc-dangerous-hosts (list "gnu\\.org")) (erc-dangerous-host-highlight-type 'all)) (erc-match-tests--hl-type-all 'erc-dangerous-host-face)))) @@ -601,7 +595,7 @@ (erc-match-tests--perform (lambda () - (erc-tests-common-add-cmem "bob") + (erc-tests-common-add-cmem "bob" "gnu.org") (erc-tests-common-add-cmem "alice") ;; Change highlight type for category `current-nick' from the ;; default to `nick-or-keyword'. @@ -650,7 +644,7 @@ (erc-match-tests--perform (lambda () - (erc-tests-common-add-cmem "bob") + (erc-tests-common-add-cmem "bob" "gnu.org") (erc-tests-common-add-cmem "imamodel") (erc-tests-common-add-cmem "ModerNerd") @@ -735,10 +729,12 @@ (ert-deftest erc-match--opt-pat-cache () (let ((erc-match--opt-pat-cache ())) - (let ((erc-keywords '("foo"))) + (let ((erc-keywords (list "foo"))) (erc-match--keyword-p (erc-match-opt-keyword :body-beg 1 :sender "" - :command 'fake))) + :command 'fake)) + ;; Mutating a cached input does not change the saved key. + (setcar erc-keywords "fail")) (let ((erc-keywords '("bar"))) (erc-match--keyword-p (erc-match-opt-keyword :body-beg 1 :sender "" @@ -748,14 +744,15 @@ :sender "" :command 'fake))) (should (equal erc-match--opt-pat-cache - '((erc-match--opt-pat-make-addr-end - (("baz") . "\\s. \\(baz\\)\\s.")) + `((erc-match--opt-pat-make-addr-any + (,(sxhash-equal '("baz")) . "\\s. \\(baz\\)\\s.")) (erc-match--opt-pat-make-addr-beg - (("baz") . "\\<\\(baz\\)[:,] ")) + (,(sxhash-equal '("baz")) . "\\<\\(baz\\)[,:] ")) (erc-match--opt-pat-make - (("baz") . "baz")) + (,(sxhash-equal '("baz")) . "baz")) (erc-match--opt-pat-make-kw - (("bar") . "bar") (("foo") . "foo"))))))) + (,(sxhash-equal '("bar")) . "bar") + (,(sxhash-equal '("foo")) . "foo"))))))) ;; This demos bare-bones usage of the `erc-match' API that implicitly ;; opts out of the traditional options and "parts"-based mechanism. The