;; 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!*<=>+]+\\)['’]"
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
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.
(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.
(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
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)
(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