From: "J.P." <jp@neverwas.me>
To: 56450@debbugs.gnu.org
Cc: emacs-erc@gnu.org
Subject: bug#56450: 29.0.50; erc-match commands should store regular expressions
Date: Fri, 15 Jul 2022 06:38:42 -0700 [thread overview]
Message-ID: <878roujy1p.fsf__20917.9091894597$1657892359$gmane$org@neverwas.me> (raw)
In-Reply-To: <87fsjb68g1.fsf@neverwas.me> (J. P.'s message of "Fri, 08 Jul 2022 06:27:26 -0700")
[-- Attachment #1: Type: text/plain, Size: 2522 bytes --]
"J.P." <jp@neverwas.me> writes:
> Something else not included that perhaps should be is a clearer
> indication that items added interactively can match any substring in a
> candidate without regard for boundaries. It may also be worth
> contrasting this with what's ultimately highlighted. For example, if you
> "M-x erc-add-pal RET bo RET", then "<bob>" (minus the brackets) will be
> highlighted. Compare this to keywords, where only the matched portion
> appears in a designated face.
This is nonsense (apologies). ERC already includes this information in
the doc strings for `erc-current-nick-highlight-type' and friends.
> Documentation aside, it might also be nice to retain a means of
> interactively adding a regexp verbatim (IOW, the old behavior minus the
> unhelpful completion list). Perhaps this can be done via universal
> argument.
I've added an option offering to quote new items, do nothing, or ask
when applicable. By default, it's set to the latter to accommodate
infrequent users (those likeliest to have been bitten by the old
behavior). This may be received negatively by some, but there's already
precedent in `erc-cmd-IGNORE', which has no accompanying opt-out.
Also, when the choice is quote or verbatim, the opposite boolean is made
available via universal argument. For example, if you're a fan of the
status quo because you like manually composing regexps on the fly (and
don't mind slightly misleading completion offerings), you may take
comfort in knowing that ERC will happily quote them for you when
supplied with a prefix argument, should the unlikely need ever arise.
> BTW, the individual who originally brought this to our attention on
> Libera also mused about a command for jumping between keywords, so I've
> included something sketchy to that effect. However, it suffers from an
> intermittent issue that I can't yet reproduce reliably: basically, when
> first invoked, it sometimes makes Emacs unresponsive for a few seconds.
> If I can't manage to tame it, I'll just drop it from this patch set.
Despite my weird issue having magically subsided after syncing and
rebuilding, I have, for now, decided to drop the proposed command,
mainly because I've been reminded of a discussion [1] from a few months
back regarding a proposal for a mini framework for jumping between
elements of any type. I'd rather save this functionality for something
like that, provided such a thing ever materializes. Thanks.
[1] https://lists.gnu.org/archive/html/emacs-erc/2022-02/msg00010.html
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v1-v2.diff --]
[-- Type: text/x-patch, Size: 13746 bytes --]
From 2660b8c3bc3e6e0092ded870edee7eacf049fca4 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 14 Jul 2022 22:10:06 -0700
Subject: [PATCH 0/1] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (1):
Offer to regexp-quote new items in erc-match commands
lisp/erc/erc-match.el | 55 ++++++---
lisp/erc/erc.el | 4 +-
test/lisp/erc/erc-match-tests.el | 193 +++++++++++++++++++++++++++++++
3 files changed, 231 insertions(+), 21 deletions(-)
create mode 100644 test/lisp/erc/erc-match-tests.el
Interdiff:
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 76bda8c467..6b9aa47d86 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -240,6 +240,15 @@ erc-match-exclude-server-buffer
:version "24.3"
:type 'boolean)
+(defcustom erc-match-quote-when-adding 'ask
+ "Whether to `regexp-quote' when adding to a match list interactively.
+When the value is a boolean, the opposite behavior will be made
+available via universal argument."
+ :package-version '(ERC . "5.4.1") ; FIXME increment on next release
+ :type '(choice (const ask)
+ (const t)
+ (const nil)))
+
;; Internal variables:
;; This is exactly the same as erc-button-syntax-table. Should we
@@ -290,7 +299,7 @@ erc-keyword-face
;; Functions:
-(defun erc-add-entry-to-list (list prompt &optional completions regexpp)
+(defun erc-add-entry-to-list (list prompt &optional completions alt)
"Add an entry interactively to a list.
LIST must be passed as a symbol
The query happens using PROMPT.
@@ -299,9 +308,16 @@ erc-add-entry-to-list
prompt
completions
(lambda (x)
- (not (erc-member-ignore-case (car x) (symbol-value list)))))))
- (when regexpp
- (setq entry (regexp-quote entry)))
+ (not (erc-member-ignore-case (car x) (symbol-value list))))))
+ quoted)
+ (setq quoted (regexp-quote entry))
+ (when (pcase erc-match-quote-when-adding
+ ('ask (unless (string= quoted entry)
+ (y-or-n-p
+ (format "Use regexp-quoted form (%s) instead? " quoted))))
+ ('t (not alt))
+ ('nil alt))
+ (setq entry quoted))
(if (erc-member-ignore-case entry (symbol-value list))
(error "\"%s\" is already on the list" entry)
(set list (cons entry (symbol-value list))))))
@@ -329,11 +345,11 @@ erc-remove-entry-from-list
(symbol-value list))))))
;;;###autoload
-(defun erc-add-pal ()
+(defun erc-add-pal (&optional arg)
"Add pal interactively to `erc-pals'."
- (interactive)
+ (interactive "P")
(erc-add-entry-to-list 'erc-pals "Add pal: "
- (erc-get-server-nickname-alist) t))
+ (erc-get-server-nickname-alist) arg))
;;;###autoload
(defun erc-delete-pal ()
@@ -342,11 +358,11 @@ erc-delete-pal
(erc-remove-entry-from-list 'erc-pals "Delete pal: "))
;;;###autoload
-(defun erc-add-fool ()
+(defun erc-add-fool (&optional arg)
"Add fool interactively to `erc-fools'."
- (interactive)
+ (interactive "P")
(erc-add-entry-to-list 'erc-fools "Add fool: "
- (erc-get-server-nickname-alist) t))
+ (erc-get-server-nickname-alist) arg))
;;;###autoload
(defun erc-delete-fool ()
@@ -355,10 +371,10 @@ erc-delete-fool
(erc-remove-entry-from-list 'erc-fools "Delete fool: "))
;;;###autoload
-(defun erc-add-keyword ()
+(defun erc-add-keyword (&optional arg)
"Add keyword interactively to `erc-keywords'."
- (interactive)
- (erc-add-entry-to-list 'erc-keywords "Add keyword: " nil t))
+ (interactive "P")
+ (erc-add-entry-to-list 'erc-keywords "Add keyword: " nil arg))
;;;###autoload
(defun erc-delete-keyword ()
@@ -367,10 +383,10 @@ erc-delete-keyword
(erc-remove-entry-from-list 'erc-keywords "Delete keyword: "))
;;;###autoload
-(defun erc-add-dangerous-host ()
+(defun erc-add-dangerous-host (&optional arg)
"Add dangerous-host interactively to `erc-dangerous-hosts'."
- (interactive)
- (erc-add-entry-to-list 'erc-dangerous-hosts "Add dangerous-host: " nil t))
+ (interactive "P")
+ (erc-add-entry-to-list 'erc-dangerous-hosts "Add dangerous-host: " nil arg))
;;;###autoload
(defun erc-delete-dangerous-host ()
@@ -520,7 +536,7 @@ erc-match-message
(face match-face))
(when (consp regex)
(setq regex (car elt)
- face (list (cadr elt) 'erc-keyword-face)))
+ face (cdr elt)))
(goto-char (+ 2 (or nick-end
(point-min))))
(while (re-search-forward regex nil t)
@@ -647,35 +663,6 @@ erc-beep-on-match
(when (member match-type erc-beep-match-types)
(beep)))
-(declare-function text-property-search-forward "text-property-search"
- (property &optional value predicate not-current))
-(declare-function text-property-search-backward "text-property-search"
- (property &optional value predicate not-current))
-
-(defun erc-match-next-keyword (arg)
- "Jump to the ARGth next keyword, if any."
- (interactive "p")
- (require 'text-property-search)
- (let* ((f (if (< arg 0)
- #'text-property-search-backward
- #'text-property-search-forward))
- (i (1+ (abs arg)))
- (test (lambda (a b) (if (consp b) (memq a b) (eq a b))))
- (args `(font-lock-face erc-keyword-face ,test t))
- (opoint (and (> (point) erc-insert-marker) (point)))
- m)
- (when opoint
- (goto-char erc-insert-marker))
- (while (and (not (zerop (cl-decf i))) (setq m (apply f args)))
- (goto-char (prop-match-beginning m)))
- (unless (or m (not opoint))
- (goto-char opoint))))
-
-(defun erc-match-previous-keyword (arg)
- "Jump to the ARGth previous keyword, if any"
- (interactive "p")
- (erc-match-next-keyword (- arg)))
-
(provide 'erc-match)
;;; erc-match.el ends here
diff --git a/test/lisp/erc/erc-match-tests.el b/test/lisp/erc/erc-match-tests.el
index 7f0159544f..cd7598703b 100644
--- a/test/lisp/erc/erc-match-tests.el
+++ b/test/lisp/erc/erc-match-tests.el
@@ -23,6 +23,50 @@
(require 'ert-x)
(require 'erc-match)
+
+(ert-deftest erc-add-entry-to-list ()
+ (let ((erc-pals '("z"))
+ (erc-match-quote-when-adding 'ask))
+
+ (ert-info ("Default (ask)")
+ (ert-simulate-keys "\t\ry\r"
+ (erc-add-entry-to-list 'erc-pals "?" '((".")) nil)
+ (should (equal (pop erc-pals) "\\.")))
+
+ (ert-info ("Inverted")
+ (ert-simulate-keys "\t\ry\r"
+ (erc-add-entry-to-list 'erc-pals "?" '((".")) nil)
+ (should (equal (pop erc-pals) "\\."))))
+
+ (ert-info ("Skipped")
+ (ert-simulate-keys "\t\r"
+ (erc-add-entry-to-list 'erc-pals "?" '(("x")) nil)
+ (should (equal (pop erc-pals) "x")))))
+
+ (ert-info ("Verbatim")
+ (setq erc-match-quote-when-adding nil)
+ (ert-simulate-keys "\t\r"
+ (erc-add-entry-to-list 'erc-pals "?" '((".")) nil)
+ (should (equal (pop erc-pals) ".")))
+
+ (ert-info ("Inverted")
+ (ert-simulate-keys "\t\r"
+ (erc-add-entry-to-list 'erc-pals "?" '((".")) t)
+ (should (equal (pop erc-pals) "\\.")))))
+
+ (ert-info ("Quoted")
+ (setq erc-match-quote-when-adding t)
+ (ert-simulate-keys "\t\r"
+ (erc-add-entry-to-list 'erc-pals "?" '((".")) nil)
+ (should (equal (pop erc-pals) "\\.")))
+
+ (ert-info ("Inverted")
+ (ert-simulate-keys "\t\r"
+ (erc-add-entry-to-list 'erc-pals "?" '((".")) t)
+ (should (equal (pop erc-pals) ".")))))
+
+ (should (equal erc-pals '("z")))))
+
(ert-deftest erc-pals ()
(with-temp-buffer
(setq erc-server-process (start-process "true" (current-buffer) "true")
@@ -31,7 +75,8 @@ erc-pals
(erc-add-server-user "FOO[m]" (make-erc-server-user :nickname "foo[m]"))
(erc-add-server-user "tester" (make-erc-server-user :nickname "tester"))
- (let (erc-pals calls rvs)
+ (let ((erc-match-quote-when-adding t)
+ erc-pals calls rvs)
(cl-letf (((symbol-function 'completing-read)
(lambda (&rest r) (push r calls) (pop rvs))))
@@ -48,7 +93,13 @@ erc-pals
(push "foo\\[m]" rvs)
(ert-simulate-command '(erc-delete-pal))
(should (equal (cadr (pop calls)) '(("foo\\[m]"))))
- (should-not erc-pals))))))
+ (should-not erc-pals))
+
+ (ert-info ("`erc-add-pal' verbatim")
+ (push "foo[m]" rvs)
+ (ert-simulate-command '(erc-add-pal (4)))
+ (should (equal (cadr (pop calls)) '(("tester") ("foo[m]"))))
+ (should (equal erc-pals '("foo[m]"))))))))
(ert-deftest erc-fools ()
(with-temp-buffer
@@ -58,7 +109,8 @@ erc-fools
(erc-add-server-user "FOO[m]" (make-erc-server-user :nickname "foo[m]"))
(erc-add-server-user "tester" (make-erc-server-user :nickname "tester"))
- (let (erc-fools calls rvs)
+ (let ((erc-match-quote-when-adding t)
+ erc-fools calls rvs)
(cl-letf (((symbol-function 'completing-read)
(lambda (&rest r) (push r calls) (pop rvs))))
@@ -76,10 +128,17 @@ erc-fools
(push "foo\\[m]" rvs)
(ert-simulate-command '(erc-delete-fool))
(should (equal (cadr (pop calls)) '(("foo\\[m]"))))
- (should-not erc-fools))))))
+ (should-not erc-fools))
+
+ (ert-info ("`erc-add-fool' verbatim")
+ (push "foo[m]" rvs)
+ (ert-simulate-command '(erc-add-fool (4)))
+ (should (equal (cadr (pop calls)) '(("tester") ("foo[m]"))))
+ (should (equal erc-fools '("foo[m]"))))))))
(ert-deftest erc-keywords ()
- (let (erc-keywords calls rvs)
+ (let ((erc-match-quote-when-adding t)
+ erc-keywords calls rvs)
(cl-letf (((symbol-function 'completing-read)
(lambda (&rest r) (push r calls) (pop rvs))))
@@ -96,10 +155,17 @@ erc-keywords
(push "\\[cit\\. needed]" rvs)
(ert-simulate-command '(erc-delete-keyword))
(should (equal (cadr (pop calls)) '(("\\[cit\\. needed]"))))
- (should-not erc-keywords)))))
+ (should-not erc-keywords))
+
+ (ert-info ("`erc-add-keyword' verbatim")
+ (push "[...]" rvs)
+ (ert-simulate-command '(erc-add-keyword (4)))
+ (should (equal (cadr (pop calls)) nil))
+ (should (equal erc-keywords '("[...]")))))))
(ert-deftest erc-dangerous-hosts ()
- (let (erc-dangerous-hosts calls rvs)
+ (let ((erc-match-quote-when-adding t)
+ erc-dangerous-hosts calls rvs)
(cl-letf (((symbol-function 'completing-read)
(lambda (&rest r) (push r calls) (pop rvs))))
@@ -116,78 +182,12 @@ erc-dangerous-hosts
(push "example\\.net" rvs)
(ert-simulate-command '(erc-delete-dangerous-host))
(should (equal (cadr (pop calls)) '(("example\\.net"))))
- (should-not erc-dangerous-hosts)))))
-
-(defun erc-match-tests--populate ()
- (let ((erc-keywords `("five" ("six" font-lock-string-face) "\\<t.."))
- (erc-insert-modify-hook '(erc-match-message)))
-
- (erc-display-message
- (make-erc-response
- :sender "alice!~u@example.net"
- :command "PRIVMSG"
- :contents "one two three"
- :command-args '("#chan" "one two three"))
- nil (current-buffer)
- (erc-format-privmessage "alice" "one two three" nil t))
-
- (erc-display-message
- (make-erc-response
- :sender "bob!~u@example.net"
- :command "PRIVMSG"
- :contents "four five six"
- :command-args '("#chan" "four five six"))
- nil (current-buffer)
- (erc-format-privmessage "bob" "four five six" nil t))))
-
-(ert-deftest erc-match-next-keyword ()
- (with-current-buffer (get-buffer-create "#chan")
- (erc-mode)
- (insert "\n\n")
- (setq erc-input-marker (make-marker)
- erc-insert-marker (make-marker)
- erc-server-current-nick "tester")
- (set-marker erc-insert-marker (point-max))
- (erc-display-prompt)
- (erc-match-tests--populate)
- (should (= (point) erc-input-marker))
-
- (ert-info ("Back once")
- (ert-simulate-command '(erc-match-next-keyword -1))
- (should (looking-at "six")))
-
- (ert-info ("Back twice")
- (ert-simulate-command '(erc-match-next-keyword -2))
- (should (looking-at "three")))
-
- (ert-info ("Overshoot")
- (ert-simulate-command '(erc-match-next-keyword -2))
- (should (looking-at "two")))
-
- (ert-info ("About face")
- (ert-simulate-command '(erc-match-next-keyword 1))
- (should (looking-at "three")))
-
- (ert-info ("About face")
- (ert-simulate-command '(erc-match-next-keyword 1))
- (should (looking-at "five")))
-
- (ert-info ("Miss backward")
- (ert-simulate-command '(erc-match-next-keyword -100))
- (should (looking-at "two"))
- (backward-char)
- (let ((p (point)))
- (ert-simulate-command '(erc-match-next-keyword -100))
- (should (= p (point)))))
-
- (ert-info ("Miss forwards")
- (ert-simulate-command '(erc-match-next-keyword 100))
- (should (looking-at "six"))
- (goto-char (1+ (line-end-position)))
- (let ((p (point)))
- (ert-simulate-command '(erc-match-next-keyword 1))
- (should (= p (point)))))
-
- (when noninteractive (kill-buffer))))
+ (should-not erc-dangerous-hosts))
+
+ (ert-info ("`erc-add-dangerous-host' verbatim")
+ (push "example.net" rvs)
+ (ert-simulate-command '(erc-add-dangerous-host (4)))
+ (should (equal (cadr (pop calls)) nil))
+ (should (equal erc-dangerous-hosts '("example.net")))))))
;;; erc-match-tests.el ends here
--
2.36.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-Offer-to-regexp-quote-new-items-in-erc-match-command.patch --]
[-- Type: text/x-patch, Size: 14173 bytes --]
From 2660b8c3bc3e6e0092ded870edee7eacf049fca4 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 6 Jul 2022 19:57:11 -0700
Subject: [PATCH 1/1] Offer to regexp-quote new items in erc-match commands
* lisp/erc/erc-match.el (erc-match-quote-when-adding) Add new option
to quote new items added to match lists.
(erc-add-entry-to-list): Add new optional
param `alt' indicating whether to flip the behavior indicated by
`erc-match-quote-when-adding'.
(erc-add-pal, erc-add-fool, erc-add-keyword, erc-add-dangerous-host):
Pass universal arg to `erc-add-entry-to-list' as `alt' argument.
(erc-match-pal-p, erc-match-fool-p, erc-match-keyword-p,
erc-match-dangerous-host-p): Don't bother matching when list is nil.
* lisp/erc/erc.el (erc-list-match (lst str):
Join input list as regexp union instead of looping over items.
* test/lisp/erc/erc-match-tests.el: New file.
---
lisp/erc/erc-match.el | 55 ++++++---
lisp/erc/erc.el | 4 +-
test/lisp/erc/erc-match-tests.el | 193 +++++++++++++++++++++++++++++++
3 files changed, 231 insertions(+), 21 deletions(-)
create mode 100644 test/lisp/erc/erc-match-tests.el
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 7c9174ff66..6b9aa47d86 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -240,6 +240,15 @@ erc-match-exclude-server-buffer
:version "24.3"
:type 'boolean)
+(defcustom erc-match-quote-when-adding 'ask
+ "Whether to `regexp-quote' when adding to a match list interactively.
+When the value is a boolean, the opposite behavior will be made
+available via universal argument."
+ :package-version '(ERC . "5.4.1") ; FIXME increment on next release
+ :type '(choice (const ask)
+ (const t)
+ (const nil)))
+
;; Internal variables:
;; This is exactly the same as erc-button-syntax-table. Should we
@@ -290,7 +299,7 @@ erc-keyword-face
;; Functions:
-(defun erc-add-entry-to-list (list prompt &optional completions)
+(defun erc-add-entry-to-list (list prompt &optional completions alt)
"Add an entry interactively to a list.
LIST must be passed as a symbol
The query happens using PROMPT.
@@ -299,7 +308,16 @@ erc-add-entry-to-list
prompt
completions
(lambda (x)
- (not (erc-member-ignore-case (car x) (symbol-value list)))))))
+ (not (erc-member-ignore-case (car x) (symbol-value list))))))
+ quoted)
+ (setq quoted (regexp-quote entry))
+ (when (pcase erc-match-quote-when-adding
+ ('ask (unless (string= quoted entry)
+ (y-or-n-p
+ (format "Use regexp-quoted form (%s) instead? " quoted))))
+ ('t (not alt))
+ ('nil alt))
+ (setq entry quoted))
(if (erc-member-ignore-case entry (symbol-value list))
(error "\"%s\" is already on the list" entry)
(set list (cons entry (symbol-value list))))))
@@ -327,10 +345,11 @@ erc-remove-entry-from-list
(symbol-value list))))))
;;;###autoload
-(defun erc-add-pal ()
+(defun erc-add-pal (&optional arg)
"Add pal interactively to `erc-pals'."
- (interactive)
- (erc-add-entry-to-list 'erc-pals "Add pal: " (erc-get-server-nickname-alist)))
+ (interactive "P")
+ (erc-add-entry-to-list 'erc-pals "Add pal: "
+ (erc-get-server-nickname-alist) arg))
;;;###autoload
(defun erc-delete-pal ()
@@ -339,11 +358,11 @@ erc-delete-pal
(erc-remove-entry-from-list 'erc-pals "Delete pal: "))
;;;###autoload
-(defun erc-add-fool ()
+(defun erc-add-fool (&optional arg)
"Add fool interactively to `erc-fools'."
- (interactive)
+ (interactive "P")
(erc-add-entry-to-list 'erc-fools "Add fool: "
- (erc-get-server-nickname-alist)))
+ (erc-get-server-nickname-alist) arg))
;;;###autoload
(defun erc-delete-fool ()
@@ -352,10 +371,10 @@ erc-delete-fool
(erc-remove-entry-from-list 'erc-fools "Delete fool: "))
;;;###autoload
-(defun erc-add-keyword ()
+(defun erc-add-keyword (&optional arg)
"Add keyword interactively to `erc-keywords'."
- (interactive)
- (erc-add-entry-to-list 'erc-keywords "Add keyword: "))
+ (interactive "P")
+ (erc-add-entry-to-list 'erc-keywords "Add keyword: " nil arg))
;;;###autoload
(defun erc-delete-keyword ()
@@ -364,10 +383,10 @@ erc-delete-keyword
(erc-remove-entry-from-list 'erc-keywords "Delete keyword: "))
;;;###autoload
-(defun erc-add-dangerous-host ()
+(defun erc-add-dangerous-host (&optional arg)
"Add dangerous-host interactively to `erc-dangerous-hosts'."
- (interactive)
- (erc-add-entry-to-list 'erc-dangerous-hosts "Add dangerous-host: "))
+ (interactive "P")
+ (erc-add-entry-to-list 'erc-dangerous-hosts "Add dangerous-host: " nil arg))
;;;###autoload
(defun erc-delete-dangerous-host ()
@@ -388,19 +407,19 @@ erc-match-current-nick-p
(defun erc-match-pal-p (nickuserhost _msg)
"Check whether NICKUSERHOST is in `erc-pals'.
MSG will be ignored."
- (and nickuserhost
+ (and nickuserhost erc-pals
(erc-list-match erc-pals nickuserhost)))
(defun erc-match-fool-p (nickuserhost msg)
"Check whether NICKUSERHOST is in `erc-fools' or MSG is directed at a fool."
- (and msg nickuserhost
+ (and msg nickuserhost erc-fools
(or (erc-list-match erc-fools nickuserhost)
(erc-match-directed-at-fool-p msg))))
(defun erc-match-keyword-p (_nickuserhost msg)
"Check whether any keyword of `erc-keywords' matches for MSG.
NICKUSERHOST will be ignored."
- (and msg
+ (and msg erc-keywords
(erc-list-match
(mapcar (lambda (x)
(if (listp x)
@@ -412,7 +431,7 @@ erc-match-keyword-p
(defun erc-match-dangerous-host-p (nickuserhost _msg)
"Check whether NICKUSERHOST is in `erc-dangerous-hosts'.
MSG will be ignored."
- (and nickuserhost
+ (and nickuserhost erc-dangerous-hosts
(erc-list-match erc-dangerous-hosts nickuserhost)))
(defun erc-match-directed-at-fool-p (msg)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 0a16831fba..bae896a2ea 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -6282,9 +6282,7 @@ erc-user-spec
(defun erc-list-match (lst str)
"Return non-nil if any regexp in LST matches STR."
- (memq nil (mapcar (lambda (regexp)
- (not (string-match regexp str)))
- lst)))
+ (and lst (string-match (string-join lst "\\|") str)))
;; other "toggles"
diff --git a/test/lisp/erc/erc-match-tests.el b/test/lisp/erc/erc-match-tests.el
new file mode 100644
index 0000000000..cd7598703b
--- /dev/null
+++ b/test/lisp/erc/erc-match-tests.el
@@ -0,0 +1,193 @@
+;;; erc-match-tests.el --- Tests for erc-match. -*- lexical-binding:t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;; Code:
+
+(require 'ert-x)
+(require 'erc-match)
+
+
+(ert-deftest erc-add-entry-to-list ()
+ (let ((erc-pals '("z"))
+ (erc-match-quote-when-adding 'ask))
+
+ (ert-info ("Default (ask)")
+ (ert-simulate-keys "\t\ry\r"
+ (erc-add-entry-to-list 'erc-pals "?" '((".")) nil)
+ (should (equal (pop erc-pals) "\\.")))
+
+ (ert-info ("Inverted")
+ (ert-simulate-keys "\t\ry\r"
+ (erc-add-entry-to-list 'erc-pals "?" '((".")) nil)
+ (should (equal (pop erc-pals) "\\."))))
+
+ (ert-info ("Skipped")
+ (ert-simulate-keys "\t\r"
+ (erc-add-entry-to-list 'erc-pals "?" '(("x")) nil)
+ (should (equal (pop erc-pals) "x")))))
+
+ (ert-info ("Verbatim")
+ (setq erc-match-quote-when-adding nil)
+ (ert-simulate-keys "\t\r"
+ (erc-add-entry-to-list 'erc-pals "?" '((".")) nil)
+ (should (equal (pop erc-pals) ".")))
+
+ (ert-info ("Inverted")
+ (ert-simulate-keys "\t\r"
+ (erc-add-entry-to-list 'erc-pals "?" '((".")) t)
+ (should (equal (pop erc-pals) "\\.")))))
+
+ (ert-info ("Quoted")
+ (setq erc-match-quote-when-adding t)
+ (ert-simulate-keys "\t\r"
+ (erc-add-entry-to-list 'erc-pals "?" '((".")) nil)
+ (should (equal (pop erc-pals) "\\.")))
+
+ (ert-info ("Inverted")
+ (ert-simulate-keys "\t\r"
+ (erc-add-entry-to-list 'erc-pals "?" '((".")) t)
+ (should (equal (pop erc-pals) ".")))))
+
+ (should (equal erc-pals '("z")))))
+
+(ert-deftest erc-pals ()
+ (with-temp-buffer
+ (setq erc-server-process (start-process "true" (current-buffer) "true")
+ erc-server-users (make-hash-table :test #'equal))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (erc-add-server-user "FOO[m]" (make-erc-server-user :nickname "foo[m]"))
+ (erc-add-server-user "tester" (make-erc-server-user :nickname "tester"))
+
+ (let ((erc-match-quote-when-adding t)
+ erc-pals calls rvs)
+ (cl-letf (((symbol-function 'completing-read)
+ (lambda (&rest r) (push r calls) (pop rvs))))
+
+ (ert-info ("`erc-add-pal'")
+ (push "foo[m]" rvs)
+ (ert-simulate-command '(erc-add-pal))
+ (should (equal (cadr (pop calls)) '(("tester") ("foo[m]"))))
+ (should (equal erc-pals '("foo\\[m]"))))
+
+ (ert-info ("`erc-match-pal-p'")
+ (should (erc-match-pal-p "FOO[m]!~u@example.net" nil)))
+
+ (ert-info ("`erc-delete-pal'")
+ (push "foo\\[m]" rvs)
+ (ert-simulate-command '(erc-delete-pal))
+ (should (equal (cadr (pop calls)) '(("foo\\[m]"))))
+ (should-not erc-pals))
+
+ (ert-info ("`erc-add-pal' verbatim")
+ (push "foo[m]" rvs)
+ (ert-simulate-command '(erc-add-pal (4)))
+ (should (equal (cadr (pop calls)) '(("tester") ("foo[m]"))))
+ (should (equal erc-pals '("foo[m]"))))))))
+
+(ert-deftest erc-fools ()
+ (with-temp-buffer
+ (setq erc-server-process (start-process "true" (current-buffer) "true")
+ erc-server-users (make-hash-table :test #'equal))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (erc-add-server-user "FOO[m]" (make-erc-server-user :nickname "foo[m]"))
+ (erc-add-server-user "tester" (make-erc-server-user :nickname "tester"))
+
+ (let ((erc-match-quote-when-adding t)
+ erc-fools calls rvs)
+ (cl-letf (((symbol-function 'completing-read)
+ (lambda (&rest r) (push r calls) (pop rvs))))
+
+ (ert-info ("`erc-add-fool'")
+ (push "foo[m]" rvs)
+ (ert-simulate-command '(erc-add-fool))
+ (should (equal (cadr (pop calls)) '(("tester") ("foo[m]"))))
+ (should (equal erc-fools '("foo\\[m]"))))
+
+ (ert-info ("`erc-match-fool-p'")
+ (should (erc-match-fool-p "FOO[m]!~u@example.net" ""))
+ (should (erc-match-fool-p "tester!~u@example.net" "FOO[m]: die")))
+
+ (ert-info ("`erc-delete-fool'")
+ (push "foo\\[m]" rvs)
+ (ert-simulate-command '(erc-delete-fool))
+ (should (equal (cadr (pop calls)) '(("foo\\[m]"))))
+ (should-not erc-fools))
+
+ (ert-info ("`erc-add-fool' verbatim")
+ (push "foo[m]" rvs)
+ (ert-simulate-command '(erc-add-fool (4)))
+ (should (equal (cadr (pop calls)) '(("tester") ("foo[m]"))))
+ (should (equal erc-fools '("foo[m]"))))))))
+
+(ert-deftest erc-keywords ()
+ (let ((erc-match-quote-when-adding t)
+ erc-keywords calls rvs)
+ (cl-letf (((symbol-function 'completing-read)
+ (lambda (&rest r) (push r calls) (pop rvs))))
+
+ (ert-info ("`erc-add-keyword'")
+ (push "[cit. needed]" rvs)
+ (ert-simulate-command '(erc-add-keyword))
+ (should (equal (cadr (pop calls)) nil))
+ (should (equal erc-keywords '("\\[cit\\. needed]"))))
+
+ (ert-info ("`erc-match-keyword-p'")
+ (should (erc-match-keyword-p nil "is pretty [cit. needed]")))
+
+ (ert-info ("`erc-delete-keyword'")
+ (push "\\[cit\\. needed]" rvs)
+ (ert-simulate-command '(erc-delete-keyword))
+ (should (equal (cadr (pop calls)) '(("\\[cit\\. needed]"))))
+ (should-not erc-keywords))
+
+ (ert-info ("`erc-add-keyword' verbatim")
+ (push "[...]" rvs)
+ (ert-simulate-command '(erc-add-keyword (4)))
+ (should (equal (cadr (pop calls)) nil))
+ (should (equal erc-keywords '("[...]")))))))
+
+(ert-deftest erc-dangerous-hosts ()
+ (let ((erc-match-quote-when-adding t)
+ erc-dangerous-hosts calls rvs)
+ (cl-letf (((symbol-function 'completing-read)
+ (lambda (&rest r) (push r calls) (pop rvs))))
+
+ (ert-info ("`erc-add-dangerous-host'")
+ (push "example.net" rvs)
+ (ert-simulate-command '(erc-add-dangerous-host))
+ (should (equal (cadr (pop calls)) nil))
+ (should (equal erc-dangerous-hosts '("example\\.net"))))
+
+ (ert-info ("`erc-match-dangerous-host-p'")
+ (should (erc-match-dangerous-host-p "FOO[m]!~u@example.net" nil)))
+
+ (ert-info ("`erc-delete-dangerous-host'")
+ (push "example\\.net" rvs)
+ (ert-simulate-command '(erc-delete-dangerous-host))
+ (should (equal (cadr (pop calls)) '(("example\\.net"))))
+ (should-not erc-dangerous-hosts))
+
+ (ert-info ("`erc-add-dangerous-host' verbatim")
+ (push "example.net" rvs)
+ (ert-simulate-command '(erc-add-dangerous-host (4)))
+ (should (equal (cadr (pop calls)) nil))
+ (should (equal erc-dangerous-hosts '("example.net")))))))
+
+;;; erc-match-tests.el ends here
--
2.36.1
prev parent reply other threads:[~2022-07-15 13:38 UTC|newest]
Thread overview: 2+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-07-08 13:27 bug#56450: 29.0.50; erc-match commands should store regular expressions J.P.
2022-07-15 13:38 ` J.P. [this message]
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='878roujy1p.fsf__20917.9091894597$1657892359$gmane$org@neverwas.me' \
--to=jp@neverwas.me \
--cc=56450@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).