From 5adda2f4683fe23efd659fc7418044c8230772c5 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 15 Apr 2023 09:52:05 -0700 Subject: [PATCH] Revise FORM-as-function interface in erc-button-alist * lisp/erc/erc-button.el (erc-button-alist): Remove redundant "" entry, which adds nothing beyond highlighting the surrounding bookends at the expense of doubling up on face properties for no reason. Revise the FORM-as-function interface by removing the dynamic binding of face options and treating all implementers as replacements for `erc-button-add-button'. (erc-button--maybe-warn-arbitrary-sexp): Make more robust by having it handle all accepted FORM types other than booleans. (erc-button-add-buttons-1): Rework to only check FORM field once. (erc-button--substitute-command-keys-in-region, erc-button--display-error-with-buttons): Rename former as latter and change signature to conform to new `erc-button-add-buttons' interface. (erc-button--display-error-notice-with-keys): Call renamed helper. * test/lisp/erc/erc-button-tests.el (erc-button-alist--url, erc-button-tests--form, erc-button-tests--some-var, erc-button-tests--erc-button-alist--function-as-form, erc-button-alist--function-as-form, erc-button-tests--erc-button-alist--nil-form, erc-button-alist---nil-form): Add tests and helpers. (Bug#60933) --- etc/ERC-NEWS | 3 +- lisp/erc/erc-button.el | 91 +++++++++++++------------ test/lisp/erc/erc-button-tests.el | 106 ++++++++++++++++++++++++++++++ 3 files changed, 153 insertions(+), 47 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 3907b7bc5f2..f2a8eb72b95 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -209,7 +209,8 @@ changes are encouraged to voice their concerns on the bug list. Two helper macros from GNU ELPA's Compat library are now available to third-party modules as 'erc-compat-call' and 'erc-compat-function'. In the area of buttons, 'Info-goto-node' has been supplanted by plain -old 'info' in 'erc-button-alist', primarily for autoloading purposes. +old 'info' in 'erc-button-alist', and the bracketed "" +pattern entry has been removed because it was more or less redundant. And the "TAB" key is now bound to a new command, 'erc-tab', that only calls 'completion-at-point' when point is in the input area and module-specific commands, like 'erc-button-next', otherwise. diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index e2447deecde..7376c18ad4c 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -128,7 +128,6 @@ longer than `erc-fill-column'." ;; things hard to maintain. '((nicknames 0 erc-button-buttonize-nicks erc-nick-popup 0) (erc-button-url-regexp 0 t browse-url-button-open-url 0) - (" ]+\\) *>" 0 t browse-url-button-open-url 1) ;;; ("(\\(\\([^~\n \t@][^\n \t@]*\\)@\\([a-zA-Z0-9.:-]+\\)\\)" 1 t finger 2 3) ;; emacs internal ("[`‘]\\([a-zA-Z][-a-zA-Z_0-9!*<=>+]+\\)['’]" @@ -166,17 +165,14 @@ REGEXP is the string matching text around the button or a symbol BUTTON is the number of the regexp grouping actually matching the button. This is ignored if REGEXP is `nicknames'. -FORM is a Lisp symbol for a special variable whose value must be - true for the button to be added. Alternatively, when REGEXP is - not `nicknames', FORM can be a function whose arguments are BEG - and END, the bounds of the button in the current buffer. It's - expected to return a cons of (possibly identical) bounds or - nil, to deny. For the extent of the call, all face options - defined for the button module are re-bound, shadowing - themselves, so the function is free to change their values. - When regexp is the special symbol `nicknames', FORM must be the - symbol `erc-button-buttonize-nicks'. Specifying anything else - is deprecated. +FORM is either a boolean or a special variable whose value must + be non-nil for the button to be added. When REGEXP is the + special symbol `nicknames', FORM must be the symbol + `erc-button-buttonize-nicks'. Anything else is deprecated. + For all other entries, FORM can also be a function to call in + place of `erc-button-add-button' with the exact same arguments. + When FORM is also a special variable, ERC disregards the + variable and calls the function. CALLBACK is the function to call when the user push this button. CALLBACK can also be a symbol. Its variable value will be used @@ -288,15 +284,18 @@ specified by `erc-button-alist'." entry))))))))))) (defun erc-button--maybe-warn-arbitrary-sexp (form) - (if (and (symbolp form) (special-variable-p form)) - (symbol-value form) - (unless (get 'erc-button--maybe-warn-arbitrary-sexp 'warned-arbitrary-sexp) - (put 'erc-button--maybe-warn-arbitrary-sexp 'warned-arbitrary-sexp t) - (lwarn 'erc :warning - (concat "Arbitrary sexps for the third FORM" - " slot of `erc-button-alist' entries" - " have been deprecated."))) - (eval form t))) + (cl-assert (not (booleanp form))) ; covered by caller + ;; If a special-variable is also a function, favor the function. + (cond ((functionp form) form) + ((and (symbolp form) (special-variable-p form)) (symbol-value form)) + (t (unless (get 'erc-button--maybe-warn-arbitrary-sexp + 'warned-arbitrary-sexp) + (put 'erc-button--maybe-warn-arbitrary-sexp + 'warned-arbitrary-sexp t) + (lwarn 'erc :warning (concat "Arbitrary sexps for the third FORM" + " slot of `erc-button-alist' entries" + " have been deprecated."))) + (eval form t)))) (defun erc-button--check-nicknames-entry () ;; This helper exists because the module is defined after its options. @@ -412,22 +411,22 @@ early (outer), args-filtering advice wrapping (defun erc-button-add-buttons-1 (regexp entry) "Search through the buffer for matches to ENTRY and add buttons." (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (let ((start (match-beginning (nth 1 entry))) - (end (match-end (nth 1 entry))) - (form (nth 2 entry)) - (fun (nth 3 entry)) - (data (mapcar #'match-string-no-properties (nthcdr 4 entry)))) - (when (or (eq t form) - (and (functionp form) - (let* ((erc-button-face erc-button-face) - (erc-button-mouse-face erc-button-mouse-face) - (erc-button-nickname-face erc-button-nickname-face) - (rv (funcall form start end))) - (when rv - (setq end (cdr rv) start (car rv))))) - (erc-button--maybe-warn-arbitrary-sexp form)) - (erc-button-add-button start end fun nil data regexp))))) + (let (buttonizer) + (while + (and (re-search-forward regexp nil t) + (or buttonizer + (setq buttonizer + (and-let* + ((raw-form (nth 2 entry)) + (res (or (eq t raw-form) + (erc-button--maybe-warn-arbitrary-sexp + raw-form)))) + (if (functionp res) res #'erc-button-add-button))))) + (let ((start (match-beginning (nth 1 entry))) + (end (match-end (nth 1 entry))) + (fun (nth 3 entry)) + (data (mapcar #'match-string-no-properties (nthcdr 4 entry)))) + (funcall buttonizer start end fun nil data regexp))))) (defun erc-button-remove-old-buttons () "Remove all existing buttons. @@ -682,15 +681,15 @@ and `apropos' for other symbols." (message "@%s is %d:%02d local time" beats hours minutes))) -(defun erc-button--substitute-command-keys-in-region (beg end) +(defun erc-button--display-error-with-buttons + (from to fun nick-p &optional data regexp) "Replace command in region with keys and return new bounds" - (let* ((o (buffer-substring beg end)) - (s (substitute-command-keys o))) - (unless (equal o s) - (setq erc-button-face nil)) - (delete-region beg end) - (insert s)) - (cons beg (point))) + (let* ((o (buffer-substring from to)) + (s (substitute-command-keys o)) + (erc-button-face (and (equal o s) erc-button-face))) + (delete-region from to) + (insert s) + (erc-button-add-button from (point) fun nick-p data regexp))) ;;;###autoload (defun erc-button--display-error-notice-with-keys (&optional parsed buffer @@ -727,7 +726,7 @@ non-strings, concatenate leading string members before applying erc-insert-post-hook)) (erc-button-alist `((,(rx "\\[" (group (+ (not "]"))) "]") 0 - erc-button--substitute-command-keys-in-region + erc-button--display-error-with-buttons erc-button-describe-symbol 1) ,@erc-button-alist))) (erc-display-message parsed '(notice error) (or buffer 'active) string) diff --git a/test/lisp/erc/erc-button-tests.el b/test/lisp/erc/erc-button-tests.el index ced08d117bc..6a6f6934389 100644 --- a/test/lisp/erc/erc-button-tests.el +++ b/test/lisp/erc/erc-button-tests.el @@ -23,6 +23,112 @@ (require 'erc-button) +(ert-deftest erc-button-alist--url () + (setq erc-server-process + (start-process "sleep" (current-buffer) "sleep" "1")) + (set-process-query-on-exit-flag erc-server-process nil) + (with-current-buffer (erc--open-target "#chan") + (let ((verify + (lambda (p url) + (should (equal (get-text-property p 'erc-data) (list url))) + (should (equal (get-text-property p 'mouse-face) 'highlight)) + (should (eq (get-text-property p 'font-lock-face) 'erc-button)) + (should (eq (get-text-property p 'erc-callback) + 'browse-url-button-open-url))))) + (goto-char (point-min)) + + ;; Most common (unbracketed) + (erc-display-message nil nil (current-buffer) + "Foo https://example.com bar.") + (search-forward "https") + (funcall verify (point) "https://example.com") + + ;; The still works despite being removed in ERC 5.6. + (erc-display-message nil nil (current-buffer) + "Foo bar.") + (search-forward "https") + (funcall verify (point) "https://gnu.org") + + ;; Bracketed + (erc-display-message nil nil (current-buffer) "Foo bar.") + (search-forward "ftp") + (funcall verify (point) "ftp://gnu.org")) + + (when noninteractive + (kill-buffer)))) + +(defvar erc-button-tests--form nil) +(defvar erc-button-tests--some-var nil) + +(defun erc-button-tests--form (&rest rest) + (push rest erc-button-tests--form) + (apply #'erc-button-add-button rest)) + +(defun erc-button-tests--erc-button-alist--function-as-form (func) + (setq erc-server-process + (start-process "sleep" (current-buffer) "sleep" "1")) + (set-process-query-on-exit-flag erc-server-process nil) + + (with-current-buffer (erc--open-target "#chan") + (let* ((erc-button-tests--form nil) + (entry (list (rx "+1") 0 func #'ignore 0)) + (erc-button-alist (cons entry erc-button-alist))) + + (erc-display-message nil 'notice (current-buffer) "Foo bar baz") + (erc-display-message nil nil (current-buffer) "+1") + (erc-display-message nil 'notice (current-buffer) "Spam") + (should (equal (pop erc-button-tests--form) + '(53 55 ignore nil ("+1") "\\+1"))) + (should-not erc-button-tests--form) + (goto-char (point-min)) + (search-forward "+") + (should (equal (get-text-property (point) 'erc-data) '("+1"))) + (should (equal (get-text-property (point) 'mouse-face) 'highlight)) + (should (eq (get-text-property (point) 'font-lock-face) 'erc-button)) + (should (eq (get-text-property (point) 'erc-callback) 'ignore))) + + (when noninteractive + (kill-buffer)))) + +(ert-deftest erc-button-alist--function-as-form () + (erc-button-tests--erc-button-alist--function-as-form + #'erc-button-tests--form) + + (erc-button-tests--erc-button-alist--function-as-form + (symbol-function #'erc-button-tests--form)) + + (erc-button-tests--erc-button-alist--function-as-form + (lambda (&rest r) (push r erc-button-tests--form) + (apply #'erc-button-add-button r)))) + +(defun erc-button-tests--erc-button-alist--nil-form (form) + (setq erc-server-process + (start-process "sleep" (current-buffer) "sleep" "1")) + (set-process-query-on-exit-flag erc-server-process nil) + + (with-current-buffer (erc--open-target "#chan") + (let* ((erc-button-tests--form nil) + (entry (list (rx "+1") 0 form #'ignore 0)) + (erc-button-alist (cons entry erc-button-alist))) + + (erc-display-message nil 'notice (current-buffer) "Foo bar baz") + (erc-display-message nil nil (current-buffer) "+1") + (erc-display-message nil 'notice (current-buffer) "Spam") + (should-not erc-button-tests--form) + (goto-char (point-min)) + (search-forward "+") + (should-not (get-text-property (point) 'erc-data)) + (should-not (get-text-property (point) 'mouse-face)) + (should-not (get-text-property (point) 'font-lock-face)) + (should-not (get-text-property (point) 'erc-callback))) + + (when noninteractive + (kill-buffer)))) + +(ert-deftest erc-button-alist--nil-form () + (erc-button-tests--erc-button-alist--nil-form nil) + (erc-button-tests--erc-button-alist--nil-form 'erc-button-tests--some-var)) + (defun erc-button-tests--insert-privmsg (speaker &rest msg-parts) (declare (indent 1)) (let ((msg (erc-format-privmessage speaker -- 2.39.2