procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Revise FORM-as-function interface in erc-button-alist

Browse source 
* lisp/erc/erc-button.el (erc-button-alist): Remove redundant "<URL:
foo>" 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)
This commit is contained in:
F. Jason Park 2023-04-15 09:52:05 -07:00
parent 35dd1ade7f
commit 5adda2f468
3 changed files with 153 additions and 47 deletions
Download patch file Download diff file Expand all files Collapse all files

3
etc/ERC-NEWS
View file

@ -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 Two helper macros from GNU ELPA's Compat library are now available to
third-party modules as 'erc-compat-call' and 'erc-compat-function'. third-party modules as 'erc-compat-call' and 'erc-compat-function'.
In the area of buttons, 'Info-goto-node' has been supplanted by plain 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 "<URL:...>"
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 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 calls 'completion-at-point' when point is in the input area and
module-specific commands, like 'erc-button-next', otherwise. module-specific commands, like 'erc-button-next', otherwise.

91
lisp/erc/erc-button.el
View file

@ -128,7 +128,6 @@ longer than `erc-fill-column'."
;; things hard to maintain. ;; things hard to maintain.
'((nicknames 0 erc-button-buttonize-nicks erc-nick-popup 0) '((nicknames 0 erc-button-buttonize-nicks erc-nick-popup 0)
(erc-button-url-regexp 0 t browse-url-button-open-url 0) (erc-button-url-regexp 0 t browse-url-button-open-url 0)
("<URL: *\\([^<> ]+\\) *>" 0 t browse-url-button-open-url 1)
;;; ("(\\(\\([^~\n \t@][^\n \t@]*\\)@\\([a-zA-Z0-9.:-]+\\)\\)" 1 t finger 2 3) ;;; ("(\\(\\([^~\n \t@][^\n \t@]*\\)@\\([a-zA-Z0-9.:-]+\\)\\)" 1 t finger 2 3)
;; emacs internal ;; emacs internal
("[`‘]\\([a-zA-Z][-a-zA-Z_0-9!*<=>+]+\\)['’]" ("[`‘]\\([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 is the number of the regexp grouping actually matching the
button. This is ignored if REGEXP is `nicknames'. button. This is ignored if REGEXP is `nicknames'.
FORM is a Lisp symbol for a special variable whose value must be FORM is either a boolean or a special variable whose value must
true for the button to be added. Alternatively, when REGEXP is be non-nil for the button to be added. When REGEXP is the
not `nicknames', FORM can be a function whose arguments are BEG special symbol `nicknames', FORM must be the symbol
and END, the bounds of the button in the current buffer. It's `erc-button-buttonize-nicks'. Anything else is deprecated.
expected to return a cons of (possibly identical) bounds or For all other entries, FORM can also be a function to call in
nil, to deny. For the extent of the call, all face options place of `erc-button-add-button' with the exact same arguments.
defined for the button module are re-bound, shadowing When FORM is also a special variable, ERC disregards the
themselves, so the function is free to change their values. variable and calls the function.
When regexp is the special symbol `nicknames', FORM must be the
symbol `erc-button-buttonize-nicks'. Specifying anything else
is deprecated.
CALLBACK is the function to call when the user push this button. CALLBACK is the function to call when the user push this button.
CALLBACK can also be a symbol. Its variable value will be used CALLBACK can also be a symbol. Its variable value will be used
@ -288,15 +284,18 @@ specified by `erc-button-alist'."
entry))))))))))) entry)))))))))))
(defun erc-button--maybe-warn-arbitrary-sexp (form) (defun erc-button--maybe-warn-arbitrary-sexp (form)
(if (and (symbolp form) (special-variable-p form)) (cl-assert (not (booleanp form))) ; covered by caller
(symbol-value form) ;; If a special-variable is also a function, favor the function.
(unless (get 'erc-button--maybe-warn-arbitrary-sexp 'warned-arbitrary-sexp) (cond ((functionp form) form)
(put 'erc-button--maybe-warn-arbitrary-sexp 'warned-arbitrary-sexp t) ((and (symbolp form) (special-variable-p form)) (symbol-value form))
(lwarn 'erc :warning (t (unless (get 'erc-button--maybe-warn-arbitrary-sexp
(concat "Arbitrary sexps for the third FORM" 'warned-arbitrary-sexp)
" slot of `erc-button-alist' entries" (put 'erc-button--maybe-warn-arbitrary-sexp
" have been deprecated."))) 'warned-arbitrary-sexp t)
(eval form 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 () (defun erc-button--check-nicknames-entry ()
;; This helper exists because the module is defined after its options. ;; 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) (defun erc-button-add-buttons-1 (regexp entry)
"Search through the buffer for matches to ENTRY and add buttons." "Search through the buffer for matches to ENTRY and add buttons."
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward regexp nil t) (let (buttonizer)
(let ((start (match-beginning (nth 1 entry))) (while
(end (match-end (nth 1 entry))) (and (re-search-forward regexp nil t)
(form (nth 2 entry)) (or buttonizer
(fun (nth 3 entry)) (setq buttonizer
(data (mapcar #'match-string-no-properties (nthcdr 4 entry)))) (and-let*
(when (or (eq t form) ((raw-form (nth 2 entry))
(and (functionp form) (res (or (eq t raw-form)
(let* ((erc-button-face erc-button-face) (erc-button--maybe-warn-arbitrary-sexp
(erc-button-mouse-face erc-button-mouse-face) raw-form))))
(erc-button-nickname-face erc-button-nickname-face) (if (functionp res) res #'erc-button-add-button)))))
(rv (funcall form start end))) (let ((start (match-beginning (nth 1 entry)))
(when rv (end (match-end (nth 1 entry)))
(setq end (cdr rv) start (car rv))))) (fun (nth 3 entry))
(erc-button--maybe-warn-arbitrary-sexp form)) (data (mapcar #'match-string-no-properties (nthcdr 4 entry))))
(erc-button-add-button start end fun nil data regexp))))) (funcall buttonizer start end fun nil data regexp)))))
(defun erc-button-remove-old-buttons () (defun erc-button-remove-old-buttons ()
"Remove all existing buttons. "Remove all existing buttons.
@ -682,15 +681,15 @@ and `apropos' for other symbols."
(message "@%s is %d:%02d local time" (message "@%s is %d:%02d local time"
beats hours minutes))) 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" "Replace command in region with keys and return new bounds"
(let* ((o (buffer-substring beg end)) (let* ((o (buffer-substring from to))
(s (substitute-command-keys o))) (s (substitute-command-keys o))
(unless (equal o s) (erc-button-face (and (equal o s) erc-button-face)))
(setq erc-button-face nil)) (delete-region from to)
(delete-region beg end) (insert s)
(insert s)) (erc-button-add-button from (point) fun nick-p data regexp)))
(cons beg (point)))
;;;###autoload ;;;###autoload
(defun erc-button--display-error-notice-with-keys (&optional parsed buffer (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-insert-post-hook))
(erc-button-alist (erc-button-alist
`((,(rx "\\[" (group (+ (not "]"))) "]") 0 `((,(rx "\\[" (group (+ (not "]"))) "]") 0
erc-button--substitute-command-keys-in-region erc-button--display-error-with-buttons
erc-button-describe-symbol 1) erc-button-describe-symbol 1)
,@erc-button-alist))) ,@erc-button-alist)))
(erc-display-message parsed '(notice error) (or buffer 'active) string) (erc-display-message parsed '(notice error) (or buffer 'active) string)

106
test/lisp/erc/erc-button-tests.el
View file

@ -23,6 +23,112 @@
(require 'erc-button) (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 <URL: form> still works despite being removed in ERC 5.6.
(erc-display-message nil nil (current-buffer)
"Foo <URL: https://gnu.org> bar.")
(search-forward "https")
(funcall verify (point) "https://gnu.org")
;; Bracketed
(erc-display-message nil nil (current-buffer) "Foo <ftp://gnu.org> 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) (defun erc-button-tests--insert-privmsg (speaker &rest msg-parts)
(declare (indent 1)) (declare (indent 1))
(let ((msg (erc-format-privmessage speaker (let ((msg (erc-format-privmessage speaker