master 01de334c78 4/5: Offer to regexp-quote new items in erc-match commands

[F. Jason Park]

branch: master
commit 01de334c78ee3a887aa15a65d670ae8a63f0a5b2
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    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 optional `alt' parameter 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.
    
    * etc/ERC-NEWS: Update misc-UX section for 5.5.
    
    * test/lisp/erc/erc-match-tests.el: New file. (Bug#56450)
---
 etc/ERC-NEWS                     |   6 ++
 lisp/erc/erc-match.el            |  55 +++++++----
 lisp/erc/erc.el                  |   4 +-
 test/lisp/erc/erc-match-tests.el | 193 +++++++++++++++++++++++++++++++++++++++
 4 files changed, 237 insertions(+), 21 deletions(-)

diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 7f95cdd39a..075a677a9d 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -77,6 +77,12 @@ now collapse into an alternate form designated by the option
 but can be fine-tuned via the repurposed, formerly abandoned option
 'erc-hide-prompt'.
 
+Certain commands provided by the 'erc-match' module, such as
+'erc-add-keyword', 'erc-add-pal', and others, now optionally ask
+whether to 'regexp-quote' the current input.  A new option,
+'erc-match-quote-when-adding', has been added to allow for retaining
+the old behavior, if desired.
+
 A bug has been fixed affecting users of the Soju bouncer: outgoing
 messages during periods of heavy traffic no longer disappear.
 
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 @@ server and other miscellaneous functions."
   :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 @@ Note that this is the default face to use if
 
 ;; 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 @@ Completion is performed on the optional alist COMPLETIONS."
                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 @@ car is the string."
                        (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 @@ car is the string."
   (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 @@ car is the string."
   (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 @@ car is the string."
   (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 @@ NICKUSERHOST will be ignored."
 (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 @@ NICKUSERHOST will be ignored."
 (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 84c5850361..2715121d3e 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -6284,9 +6284,7 @@ The addressed target is the string before the first colon 
in MSG."
 
 (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