procyberian/emacs
1
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
Show stats 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
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 "<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
calls 'completion-at-point' when point is in the input area and
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.
'((nicknames 0 erc-button-buttonize-nicks erc-nick-popup 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)
;; 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)

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

@ -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 <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)
(declare (indent 1))
(let ((msg (erc-format-privmessage speaker