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)
This commit is contained in:
F. Jason Park
parent
7df5b4deb8
commit
01de334c78
4 changed files with 237 additions and 21 deletions
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
||||
|
|
|
|||
193
test/lisp/erc/erc-match-tests.el
Normal file
193
test/lisp/erc/erc-match-tests.el
Normal file
|
|
@ -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
|
||||
Loading…
Add table
Reference in a new issue