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:
parent
4d6ed774fe
commit
4f3d036957
4 changed files with 65 additions and 41 deletions
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue