From 2660b8c3bc3e6e0092ded870edee7eacf049fca4 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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) "\\