1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00

Simplify erc-button-add-nickname-buttons

* lisp/erc/erc-button.el (erc-button--nick): Remove `face' slot, which
was set to `erc-button-face' by default.  It's ignored when the button
is a nick and thus useless and misleading.
(erc-button-add-nickname-buttons): Rework and reflow for readability.
Don't bind or set `erc-button' face because it's ignored when dealing
with nicks.  Don't return the value of face options when calling a
`form' function because they can be nil in practice even though their
Custom type specs do not say so.
* lisp/erc/erc-common.el (erc--with-dependent-type-match): Add helper
macro for Custom :type defs that incur warnings from `setopt' due to
some missing dependency.  This occurs when specifying a :type of
`face' instead of `symbol' and the option's default value includes
faces from another library that hasn't been loaded.
* lisp/erc/erc.el (erc--get-speaker-bounds): New helper function to
retrieve bounds of a speaker label when present.
* test/lisp/erc/erc-tests.el (erc--with-dependent-type-match): Add
test.  (Bug#64301)
This commit is contained in:
F. Jason Park 2023-06-30 23:42:01 -07:00
parent 4d6ed774fe
commit 4f3d036957
4 changed files with 65 additions and 41 deletions

View file

@ -355,8 +355,6 @@ specified by `erc-button-alist'."
( cuser nil :type (or null erc-channel-user)
;; The CDR of a value from an `erc-channel-users' table.
:documentation "A possibly nil `erc-channel-user'.")
( face erc-button-face :type symbol
:documentation "Temp `erc-button-face' while buttonizing.")
( nickname-face erc-button-nickname-face :type symbol
:documentation "Temp `erc-button-nickname-face' while buttonizing.")
( mouse-face erc-button-mouse-face :type symbol
@ -431,45 +429,43 @@ retrieve it during buttonizing via
(defun erc-button-add-nickname-buttons (entry)
"Search through the buffer for nicknames, and add buttons."
(let ((form (nth 2 entry))
(fun (nth 3 entry))
(erc-button-buttonize-nicks (and erc-button-buttonize-nicks
erc-button--modify-nick-function))
bounds word)
(when (and form (setq form (erc-button--extract-form form)))
(goto-char (point-min))
(while (erc-forward-word)
(when (setq bounds (erc-bounds-of-word-at-point))
(setq word (buffer-substring-no-properties
(car bounds) (cdr bounds)))
(let* ((erc-button-face erc-button-face)
(erc-button-mouse-face erc-button-mouse-face)
(erc-button-nickname-face erc-button-nickname-face)
(down (erc-downcase word))
(cuser (and erc-channel-users
(gethash down erc-channel-users)))
(user (or (and cuser (car cuser))
(and erc-server-users
(gethash down erc-server-users))
(funcall erc-button--fallback-user-function
down word bounds)))
(data (list word)))
(when (or (not (functionp form))
(and-let* ((user)
(obj (funcall form (make-erc-button--nick
:bounds bounds :data data
:downcased down :user user
:cuser (cdr cuser)))))
(setq bounds (erc-button--nick-bounds obj)
data (erc-button--nick-data obj)
erc-button-mouse-face
(erc-button--nick-mouse-face obj)
erc-button-nickname-face
(erc-button--nick-nickname-face obj)
erc-button-face
(erc-button--nick-face obj))))
(erc-button-add-button (car bounds) (cdr bounds)
fun t data))))))))
(when-let ((form (nth 2 entry))
;; Spoof `form' slot of default legacy `nicknames' entry
;; so `erc-button--extract-form' sees a function value.
(form (let ((erc-button-buttonize-nicks
(and erc-button-buttonize-nicks
erc-button--modify-nick-function)))
(erc-button--extract-form form)))
(seen 0))
(goto-char (point-min))
(while-let
(((erc-forward-word))
(bounds (or (and (= 1 (cl-incf seen)) (erc--get-speaker-bounds))
(erc-bounds-of-word-at-point)))
(word (buffer-substring-no-properties (car bounds) (cdr bounds)))
(down (erc-downcase word)))
(let* ((erc-button-mouse-face erc-button-mouse-face)
(erc-button-nickname-face erc-button-nickname-face)
(cuser (and erc-channel-users (gethash down erc-channel-users)))
(user (or (and cuser (car cuser))
(and erc-server-users (gethash down erc-server-users))
(funcall erc-button--fallback-user-function
down word bounds)))
(data (list word)))
(when (or (not (functionp form))
(and-let* ((user)
(obj (funcall form (make-erc-button--nick
:bounds bounds :data data
:downcased down :user user
:cuser (cdr cuser)))))
(setq erc-button-mouse-face ; might be null
(erc-button--nick-mouse-face obj)
erc-button-nickname-face ; might be null
(erc-button--nick-nickname-face obj)
data (erc-button--nick-data obj)
bounds (erc-button--nick-bounds obj))))
(erc-button-add-button (car bounds) (cdr bounds) (nth 3 entry)
'nickp data))))))
(defun erc-button-add-buttons-1 (regexp entry)
"Search through the buffer for matches to ENTRY and add buttons."

View file

@ -465,6 +465,15 @@ Use the CASEMAPPING ISUPPORT parameter to determine the style."
(inline-quote (erc-with-server-buffer
(gethash (erc-downcase ,nick) erc-server-users)))))
(defmacro erc--with-dependent-type-match (type &rest features)
"Massage Custom :type TYPE with :match function that pre-loads FEATURES."
`(backquote (,(car type)
:match
,(list '\, `(lambda (w v)
,@(mapcar (lambda (ft) `(require ',ft)) features)
(,(widget-get (widget-convert type) :match) w v)))
,@(cdr type))))
(provide 'erc-common)
;;; erc-common.el ends here

View file

@ -5073,6 +5073,16 @@ and as second argument the event parsed as a vector."
(and (erc-is-message-ctcp-p message)
(not (string-match "^\C-aACTION.*\C-a$" message))))
(define-inline erc--get-speaker-bounds ()
"Return the bounds of `erc-speaker' property when present.
Assume buffer is narrowed to the confines of an inserted message."
(inline-quote
(and-let*
(((memq (get-text-property (point) 'erc-command) '(PRIVMSG NOTICE)))
(beg (or (and (get-text-property (point-min) 'erc-speaker) (point-min))
(next-single-property-change (point-min) 'erc-speaker))))
(cons beg (next-single-property-change beg 'erc-speaker)))))
(defvar erc--user-from-nick-function #'erc--examine-nick
"Function to possibly consider unknown user.
Must return either nil or a cons of an `erc-server-user' and a