From: F. Jason Park Date: Sat, 1 Jul 2023 06:42:01 +0000 (-0700) Subject: Simplify erc-button-add-nickname-buttons X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=4f3d036957a754f2e870fc54c7e3f539d215e57e;p=emacs.git 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) --- diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 0c616a6026d..c30f7c10ca6 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -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." diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index f152a1a32d9..7bd549abfc1 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -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 diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 7693947873e..6c3dc82b133 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -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 diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 449b8e0df42..8d63936b7c2 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -129,6 +129,15 @@ (advice-remove 'buffer-local-value 'erc-with-server-buffer))) +(ert-deftest erc--with-dependent-type-match () + (should (equal (macroexpand-1 + '(erc--with-dependent-type-match (repeat face) erc-match)) + '(backquote + (repeat :match ,(lambda (w v) + (require 'erc-match) + (widget-editable-list-match w v)) + face))))) + (defun erc-tests--send-prep () ;; Caller should probably shadow `erc-insert-modify-hook' or ;; populate user tables for erc-button.