From a40795bcf278b6c2b5aacde0dc5128afafadfada Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 6 Jul 2022 19:57:11 -0700 Subject: [PATCH 1/2] Quote new entries as regexps in erc-match commands * lisp/erc/erc-match.el (erc-add-entry-to-list): Append optional param `regexpp' indicating whether to `regexp-quote' the input. (erc-add-pal, erc-add-fool, erc-add-keyword, erc-add-dangerous-host): Call `erc-add-entry-to-list' with regexpp flag set. (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 | 21 +++--- lisp/erc/erc.el | 4 +- test/lisp/erc/erc-match-tests.el | 121 +++++++++++++++++++++++++++++++ 3 files changed, 134 insertions(+), 12 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..20fe640225 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -290,7 +290,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 regexpp) "Add an entry interactively to a list. LIST must be passed as a symbol The query happens using PROMPT. @@ -300,6 +300,8 @@ erc-add-entry-to-list completions (lambda (x) (not (erc-member-ignore-case (car x) (symbol-value list))))))) + (when regexpp + (setq entry (regexp-quote entry))) (if (erc-member-ignore-case entry (symbol-value list)) (error "\"%s\" is already on the list" entry) (set list (cons entry (symbol-value list)))))) @@ -330,7 +332,8 @@ erc-remove-entry-from-list (defun erc-add-pal () "Add pal interactively to `erc-pals'." (interactive) - (erc-add-entry-to-list 'erc-pals "Add pal: " (erc-get-server-nickname-alist))) + (erc-add-entry-to-list 'erc-pals "Add pal: " + (erc-get-server-nickname-alist) t)) ;;;###autoload (defun erc-delete-pal () @@ -343,7 +346,7 @@ erc-add-fool "Add fool interactively to `erc-fools'." (interactive) (erc-add-entry-to-list 'erc-fools "Add fool: " - (erc-get-server-nickname-alist))) + (erc-get-server-nickname-alist) t)) ;;;###autoload (defun erc-delete-fool () @@ -355,7 +358,7 @@ erc-delete-fool (defun erc-add-keyword () "Add keyword interactively to `erc-keywords'." (interactive) - (erc-add-entry-to-list 'erc-keywords "Add keyword: ")) + (erc-add-entry-to-list 'erc-keywords "Add keyword: " nil t)) ;;;###autoload (defun erc-delete-keyword () @@ -367,7 +370,7 @@ erc-delete-keyword (defun erc-add-dangerous-host () "Add dangerous-host interactively to `erc-dangerous-hosts'." (interactive) - (erc-add-entry-to-list 'erc-dangerous-hosts "Add dangerous-host: ")) + (erc-add-entry-to-list 'erc-dangerous-hosts "Add dangerous-host: " nil t)) ;;;###autoload (defun erc-delete-dangerous-host () @@ -388,19 +391,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 +415,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 239d8ebdcb..005207d945 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -6284,9 +6284,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..aed23e665d --- /dev/null +++ b/test/lisp/erc/erc-match-tests.el @@ -0,0 +1,121 @@ +;;; 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 . + +;;; Commentary: +;;; Code: + +(require 'ert-x) +(require 'erc-match) + +(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-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-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-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-deftest erc-keywords () + (let (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-deftest erc-dangerous-hosts () + (let (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))))) + +;;; erc-match-tests.el ends here -- 2.36.1