From unknown Sun Aug 17 04:17:27 2025 X-Loop: help-debbugs@gnu.org Subject: bug#56450: 29.0.50; erc-match commands should store regular expressions Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: emacs-erc@gnu.org, bug-gnu-emacs@gnu.org Resent-Date: Fri, 08 Jul 2022 13:28:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 56450 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch To: 56450@debbugs.gnu.org Cc: emacs-erc@gnu.org X-Debbugs-Original-To: bug-gnu-emacs@gnu.org X-Debbugs-Original-Xcc: emacs-erc@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.165728686313088 (code B ref -1); Fri, 08 Jul 2022 13:28:02 +0000 Received: (at submit) by debbugs.gnu.org; 8 Jul 2022 13:27:43 +0000 Received: from localhost ([127.0.0.1]:59120 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1o9o1F-0003Oz-Ox for submit@debbugs.gnu.org; Fri, 08 Jul 2022 09:27:43 -0400 Received: from lists.gnu.org ([209.51.188.17]:54780) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1o9o1D-0003Or-Nn for submit@debbugs.gnu.org; Fri, 08 Jul 2022 09:27:40 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:36136) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1o9o1D-0006lU-G6 for bug-gnu-emacs@gnu.org; Fri, 08 Jul 2022 09:27:39 -0400 Received: from mail-108-mta116.mxroute.com ([136.175.108.116]:42521) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1o9o1A-0007O7-9v for bug-gnu-emacs@gnu.org; Fri, 08 Jul 2022 09:27:39 -0400 Received: from filter006.mxroute.com ([140.82.40.27] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta116.mxroute.com (ZoneMTA) with ESMTPSA id 181ddfe762e0000261.001 for (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES128-GCM-SHA256); Fri, 08 Jul 2022 13:27:30 +0000 X-Zone-Loop: 7717072223ff24b1193eb9fac097e5ea14a53c36ba54 X-Originating-IP: [140.82.40.27] DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=neverwas.me ; s=x; h=Content-Type:MIME-Version:Message-ID:Date:Subject:To:From:Sender: Reply-To:Cc:Content-Transfer-Encoding:Content-ID:Content-Description: Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc:Resent-Message-ID: In-Reply-To:References:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=dtEJx6h5tr4nS+C1ztrOftnBj6qoj2QRuRspDYbYK0s=; b=dcyF+4HKWMggDosD8CKB7/64Dj v+j8qiI5Ux4RlQ7ZY0T74GCETNvDuAPaO2ljuq7nA3sb+N/LYgFIBec+rln+MJ/5qn013CJITXwUx RDJALMofr/WeQ/LFEHGsyPm3XInIE6UtgrxThaSMf04C5Rnz7I3FTXWgzAarbhFo2PRBSX5/eObAX Awo83Sj8N4/rfovl1yK2E/ASklLAVJCpkezFZVN4nP8ssXCxsuzkMxGSB82JJTtv1+lBI94UiUT7c 2lr4JxF9t4j5Ppwf1VZGWps1emR8EpXOewu5wXAdDjj1JG9XDrcc5jGhE1Cu+aZV0Qv/Ezhe3GWcL mfzit/Mw==; From: "J.P." Date: Fri, 08 Jul 2022 06:27:26 -0700 Message-ID: <87fsjb68g1.fsf@neverwas.me> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/29.0.50 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-AuthUser: masked@neverwas.me Received-SPF: pass client-ip=136.175.108.116; envelope-from=jp@neverwas.me; helo=mail-108-mta116.mxroute.com X-Spam_score_int: -16 X-Spam_score: -1.7 X-Spam_bar: - X-Spam_report: (-1.7 / 5.0 requ) BAYES_00=-1.9, DKIM_INVALID=0.1, DKIM_SIGNED=0.1, SPF_HELO_NONE=0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=no autolearn_force=no X-Spam_action: no action X-Spam-Score: -1.4 (-) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -2.4 (--) --=-=-= Content-Type: text/plain Tags: patch Currently, pals, fools, keywords, etc. aren't `regexp-quote'd by their associated commands (such as `erc-add-pal') before being added as match patterns. Thus, items containing special characters, like "boo[m]" or "lol.fun.dad", tend to be ineffective. Worse, invalid regexps containing things like unmatched brackets create errors in the process filter. 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 "" (minus the brackets) will be highlighted. Compare this to keywords, where only the matched portion appears in a designated face. 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. 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. Lastly, these changes (as presented) uphold the proud ERC tradition of mutating custom options on behalf of a user. If this is truly objectionable, then I can switch to network-local analogs instead. However, such a move may adversely affect third-party code, given that this module's been around in roughly the same form for some 20 odd years. Thanks, J.P. P.S. This bug is not (yet) associated with any planned ERC release. In GNU Emacs 29.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.24.34, cairo version 1.17.6) of 2022-07-06 built on localhost Repository revision: e6504c3eda12c72268d2db6598764f043b74c24d Repository branch: master Windowing system distributor 'The X.Org Foundation', version 11.0.12014000 System Description: Fedora Linux 36 (Workstation Edition) Configured using: 'configure --enable-check-lisp-object-type --enable-checking=yes,glyphs 'CFLAGS=-O0 -g3' PKG_CONFIG_PATH=:/usr/lib64/pkgconfig:/usr/share/pkgconfig' Configured features: ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GPM GSETTINGS HARFBUZZ JPEG JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 M17N_FLT MODULES NOTIFY INOTIFY PDUMPER PNG RSVG SECCOMP SOUND SQLITE3 THREADS TIFF TOOLKIT_SCROLL_BARS WEBP X11 XDBE XIM XINPUT2 XPM GTK3 ZLIB Important settings: value of $LANG: en_US.UTF-8 value of $XMODIFIERS: @im=ibus locale-coding-system: utf-8-unix Major mode: Lisp Interaction Minor modes in effect: tooltip-mode: t global-eldoc-mode: t eldoc-mode: t show-paren-mode: t electric-indent-mode: t mouse-wheel-mode: t tool-bar-mode: t menu-bar-mode: t file-name-shadow-mode: t global-font-lock-mode: t font-lock-mode: t blink-cursor-mode: t line-number-mode: t indent-tabs-mode: t transient-mark-mode: t auto-composition-mode: t auto-encryption-mode: t auto-compression-mode: t Load-path shadows: None found. Features: (shadow sort mail-extr emacsbug message mailcap yank-media puny dired dired-loaddefs rfc822 mml mml-sec password-cache epa derived epg rfc6068 epg-config gnus-util text-property-search time-date subr-x mm-decode mm-bodies mm-encode mail-parse rfc2231 mailabbrev gmm-utils mailheader cl-loaddefs cl-lib sendmail rfc2047 rfc2045 ietf-drums mm-util mail-prsvr mail-utils rmc iso-transl tooltip eldoc paren electric uniquify ediff-hook vc-hooks lisp-float-type elisp-mode mwheel term/x-win x-win term/common-win x-dnd tool-bar dnd fontset image regexp-opt fringe tabulated-list replace newcomment text-mode lisp-mode prog-mode register page tab-bar menu-bar rfn-eshadow isearch easymenu timer select scroll-bar mouse jit-lock font-lock syntax font-core term/tty-colors frame minibuffer nadvice seq simple cl-generic indonesian philippine cham georgian utf-8-lang misc-lang vietnamese tibetan thai tai-viet lao korean japanese eucjp-ms cp51932 hebrew greek romanian slovak czech european ethiopic indian cyrillic chinese composite emoji-zwj charscript charprop case-table epa-hook jka-cmpr-hook help abbrev obarray oclosure cl-preloaded button loaddefs faces cus-face macroexp files window text-properties overlay sha1 md5 base64 format env code-pages mule custom widget keymap hashtable-print-readable backquote threads dbusbind inotify lcms2 dynamic-setting system-font-setting font-render-setting cairo move-toolbar gtk x-toolkit xinput2 x multi-tty make-network-process emacs) Memory information: ((conses 16 35545 5688) (symbols 48 5073 0) (strings 32 13303 1546) (string-bytes 1 429956) (vectors 16 9197) (vector-slots 8 145428 11407) (floats 8 21 25) (intervals 56 214 0) (buffers 992 10)) --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Quote-new-entries-as-regexps-in-erc-match-commands.patch >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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-Add-command-to-jump-to-erc-match-keywords.patch >From 0e8a8d030117022b6e3beaf7ab76c8bf70ff29a7 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 6 Jul 2022 20:53:41 -0700 Subject: [PATCH 2/2] Add command to jump to erc-match keywords * lisp/erc/erc-match.el (erc-match-next-keyword, erc-match-previous-keyword): Add new commands. * tests/lisp/erc/erc-match-tests.el: New file. --- lisp/erc/erc-match.el | 31 +++++++++++++- test/lisp/erc/erc-match-tests.el | 72 ++++++++++++++++++++++++++++++++ 2 files changed, 102 insertions(+), 1 deletion(-) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 20fe640225..76bda8c467 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -520,7 +520,7 @@ erc-match-message (face match-face)) (when (consp regex) (setq regex (car elt) - face (cdr elt))) + face (list (cadr elt) 'erc-keyword-face))) (goto-char (+ 2 (or nick-end (point-min)))) (while (re-search-forward regex nil t) @@ -647,6 +647,35 @@ 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 aed23e665d..7f0159544f 100644 --- a/test/lisp/erc/erc-match-tests.el +++ b/test/lisp/erc/erc-match-tests.el @@ -118,4 +118,76 @@ erc-dangerous-hosts (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) "\\ Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 15 Jul 2022 13:39:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 56450 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch To: 56450@debbugs.gnu.org Cc: emacs-erc@gnu.org Received: via spool by 56450-submit@debbugs.gnu.org id=B56450.16578923404948 (code B ref 56450); Fri, 15 Jul 2022 13:39:01 +0000 Received: (at 56450) by debbugs.gnu.org; 15 Jul 2022 13:39:00 +0000 Received: from localhost ([127.0.0.1]:39889 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oCLX0-0001Hj-Tn for submit@debbugs.gnu.org; Fri, 15 Jul 2022 09:39:00 -0400 Received: from mail-108-mta231.mxroute.com ([136.175.108.231]:46499) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oCLWx-0001HO-D7 for 56450@debbugs.gnu.org; Fri, 15 Jul 2022 09:38:57 -0400 Received: from filter006.mxroute.com ([140.82.40.27] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta231.mxroute.com (ZoneMTA) with ESMTPSA id 18202154b6c0000261.001 for <56450@debbugs.gnu.org> (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES128-GCM-SHA256); Fri, 15 Jul 2022 13:38:46 +0000 X-Zone-Loop: 13ee83cc184de2036e1787632d11b7ba329dec22dbd6 X-Originating-IP: [140.82.40.27] DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=neverwas.me ; s=x; h=Content-Type:MIME-Version:Message-ID:In-Reply-To:Date:References: Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding:Content-ID: Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc :Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=6YtHi9+WasDO/HXgukOjEB/HWInldpqJr3TaDGMjImE=; b=i8sqzgU+G7Ub5aRgrpMcZ3xokm JHoiVPifCRjo4CB4QG3rSgxt9pBvHnFVBrePv3mAcOp8yCMfZMfd9LHt/Z/cnK4Wqahx+K0uJtuCo +r8FWc/6YJACbGaMHq1me0Lo9BoH0+pdnykWHRN0RtR3SKErdX+71n0aTbFgvscUVuVy4B6/qNKDT pubw+DxQ/OGRkpm/MbL/KEcvoaVjtYxnTsfvI4lqwX9dMNfgtF5VuTMFpiILvNu6VFwHewLyHuVY3 Mb1S548yplr5dFhG0IGEK4OViO9UTuaR8XslNQUA7RA4YtgfEMdI1nCnWBbozXRsbkIxUJxPJVyIa Mr8fUG6w==; From: "J.P." References: <87fsjb68g1.fsf@neverwas.me> Date: Fri, 15 Jul 2022 06:38:42 -0700 In-Reply-To: <87fsjb68g1.fsf@neverwas.me> (J. P.'s message of "Fri, 08 Jul 2022 06:27:26 -0700") Message-ID: <878roujy1p.fsf@neverwas.me> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/29.0.50 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-AuthUser: masked@neverwas.me X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain "J.P." 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 "" (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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v1-v2.diff >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) "\\From 2660b8c3bc3e6e0092ded870edee7eacf049fca4 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 . + +;;; 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 --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Mon Sep 19 21:22:19 2022 Received: (at control) by debbugs.gnu.org; 20 Sep 2022 01:22:19 +0000 Received: from localhost ([127.0.0.1]:55638 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oaRxr-000144-6O for submit@debbugs.gnu.org; Mon, 19 Sep 2022 21:22:19 -0400 Received: from mail-108-mta255.mxroute.com ([136.175.108.255]:33609) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oaRxp-00013p-Ml for control@debbugs.gnu.org; Mon, 19 Sep 2022 21:22:18 -0400 Received: from mail-111-mta2.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta255.mxroute.com (ZoneMTA) with ESMTPSA id 183587d02430002b7a.001 for (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES128-GCM-SHA256); Tue, 20 Sep 2022 01:22:11 +0000 X-Zone-Loop: e44c2bf53915a96048c5769a1a1256c1b788cb97cd69 X-Originating-IP: [136.175.111.2] DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=neverwas.me ; s=x; h=Content-Type:MIME-Version:Message-ID:Date:Subject:To:From:Sender: Reply-To:Cc:Content-Transfer-Encoding:Content-ID:Content-Description: Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc:Resent-Message-ID: In-Reply-To:References:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=LCJNhInjilo4Ucp7dQhGpwUHM+jlxx6QdYHebUhiV+E=; b=LmAByVv89p+d9qFa+5v0nTnZpl sqxwsml8JsH5J7SCD/iJmPhqEGEN41bHk/JGLiemZRyaswG98zEDtX29FiaG7H3wJhXKKd439bgqS kwE6aohvRu+bX/a5cS/2qlgV1WbOVrcehlXUsaMgekwy5JiKfx9BHm2pi9Y54a6K6jjT2t0m+BF4d 2MXCikz4M+0/0WbqJDPin2pLabyiEpN1u2bl1BFHd+vfR3armtR+vwvto/2q//UKECt8KgS8Ainh1 +Qj8eBSvqezscHJs99ZKInq02uQbV5PBlijOffiauXTTQcJFsAUQ/b4Bz8Wvq8Jb8aI+p817qlkM5 9ngQsUaQ==; From: "J.P." To: control@debbugs.gnu.org Subject: control message for bug #56450 Date: Mon, 19 Sep 2022 18:22:06 -0700 Message-ID: <87wn9yg7r5.fsf@neverwas.me> MIME-Version: 1.0 Content-Type: text/plain X-Authenticated-Id: masked@neverwas.me X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: control X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) close 56450 29.1 quit