mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2026-09-10 07:46:51 -04:00
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'.
This commit is contained in:
F. Jason Park
parent
d5fea6863c
commit
0300db0ae5
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
(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'.")
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue