From 49c703272cb3d0f4ec035175e94c132fa32eaeba Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 16 Feb 2023 22:40:55 -0800 Subject: [PATCH 0/3] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (3): [5.6] Replace Info-goto-node with info in erc-button-alist [5.6] Add erc-button helper for substituting command keys [5.6] Allow erc-button-add-face to take an object lisp/erc/erc-button.el | 158 ++++++++++++++++++++++++++++++++----- lisp/erc/erc-networks.el | 22 +++--- test/lisp/erc/erc-tests.el | 56 +++++++++++++ 3 files changed, 206 insertions(+), 30 deletions(-) Interdiff: diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 478bbb52daa..49e3caf49a1 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -52,7 +52,8 @@ erc-button ;;;###autoload(autoload 'erc-button-mode "erc-button" nil t) (define-erc-module button nil "This mode buttonizes all messages according to `erc-button-alist'." - ((add-hook 'erc-insert-modify-hook #'erc-button-add-buttons 'append) + ((erc-button--check-nicknames-entry) + (add-hook 'erc-insert-modify-hook #'erc-button-add-buttons 'append) (add-hook 'erc-send-modify-hook #'erc-button-add-buttons 'append) (add-hook 'erc-complete-functions #'erc-button-next-function) (add-hook 'erc-mode-hook #'erc-button-setup)) @@ -102,15 +103,8 @@ erc-button-wrap-long-urls :type '(choice integer boolean)) (defcustom erc-button-buttonize-nicks t - "Flag indicating whether nicks should be buttonized or not. -When the value is a function, it must accept four arguments: the -bounds of the nick in the current message (as a cons), the nick -itself (case-mapped and without text properties), the nick's -`erc-server-users' entry, and a (possibly nil) `erc-channel-user' -object. It must return replacement bounds when buttonizing -should proceed and nil otherwise." - :package-version '(ERC . "5.6") - :type '(choice boolean function)) + "Flag indicating whether nicks should be buttonized or not." + :type 'boolean) (defcustom erc-button-rfc-url "https://tools.ietf.org/html/rfc%s" "URL used to browse RFC references. @@ -173,15 +167,16 @@ erc-button-alist 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, it 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. Important: different arguments are passed - when REGEXP is `nickname'; see `erc-button-buttonize-nicks' for - details. + 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. CALLBACK is the function to call when the user push this button. CALLBACK can also be a symbol. Its variable value will be used @@ -301,13 +296,45 @@ erc-button--maybe-warn-arbitrary-sexp " have been deprecated."))) (eval form t))) +(defun erc-button--check-nicknames-entry () + ;; This helper exists because the module is defined after its options. + (when-let (((eq major-mode 'erc-mode)) + (entry (alist-get 'nicknames erc-button-alist))) + (unless (eq 'erc-button-buttonize-nicks (nth 1 entry)) + (erc-button--display-error-notice-with-keys-and-warn + "Values other than `erc-button-buttonize-nicks' in the third slot of " + "the `nicknames' entry of `erc-button-alist' are deprecated.")))) + +(defun erc-button--preserve-bounds (bounds _ _ _) + "Return BOUNDS.\n\n(fn BOUNDS NICKNAME SERVER-USER CHANNEL-USER)" + bounds) + +;; This variable is intended to serve as a "core" to be wrapped by +;; (built-in) modules during setup. It's unclear whether +;; `add-function's practice of removing existing advice before +;; re-adding it is desirable when integrating modules since we're +;; mostly concerned with ensuring one "piece" precedes or follows +;; another (specific piece), which may not yet (or ever) be present. + +(defvar erc-button--modify-nick-function #'erc-button--preserve-bounds + "Function to possibly modify aspects of nick being buttonized. +Called with four args: BOUNDS NICKNAME SERVER-USER CHANNEL-USER. +BOUNDS is a cons of (BEG . END) marking the position of the nick +in the current message, which occupies the whole of the narrowed +buffer. NICKNAME is a case-mapped string without text +properties. SERVER-USER and CHANNEL-USER are the nick's +`erc-server-users' entry and its associated (though possibly nil) +`erc-channel-user' object. The function should return BOUNDS or +a suitable replacement to indicate that buttonizing ought to +proceed, and nil if it should be inhibited.") + (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)) bounds word) - (when (eq 'erc-button-buttonize-nicks form) - (setq form (symbol-value form))) + (when (eq form 'erc-button-buttonize-nicks) + (setq form (and (symbol-value form) erc-button--modify-nick-function))) (when (or (functionp form) (eq t form) (and form (erc-button--maybe-warn-arbitrary-sexp form))) @@ -574,17 +601,35 @@ erc-button--substitute-command-keys-in-region (cons beg (point))) (defun erc-button--display-error-notice-with-keys (parsed &rest strings) - "Add help keys to STRING for corner-case admonishments." + "Add help keys to STRINGS for corner-case admonishments. +Return inserted result." (when (stringp parsed) (push parsed strings) (setq parsed nil)) - (let ((string (apply #'concat strings)) - (erc-button-alist - `((,(rx "\\[" (group (+ (not "]"))) "]") 0 - erc-button--substitute-command-keys-in-region - erc-button-describe-symbol 1) - ,@erc-button-alist))) - (erc-display-error-notice parsed string))) + (let* ((string (apply #'concat strings)) + (erc-insert-post-hook + (cons (lambda () + (setq string (buffer-substring (point-min) (1- (point-max))))) + erc-insert-post-hook)) + (erc-button-alist + `((,(rx "\\[" (group (+ (not "]"))) "]") 0 + erc-button--substitute-command-keys-in-region + erc-button-describe-symbol 1) + ,@erc-button-alist))) + (erc-display-error-notice parsed string) + string)) + +(defun erc-button--display-error-notice-with-keys-and-warn (&rest args) + "Like `erc-button--display-error-notice-with-keys' but also warn." + (let ((string (apply #'erc-button--display-error-notice-with-keys args))) + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (with-syntax-table lisp-mode-syntax-table + (skip-syntax-forward "^-")) + (forward-char) + (display-warning + 'erc (buffer-substring-no-properties (point) (point-max)))))) (provide 'erc-button) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 46bb0c9ba77..4d6fd227518 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1383,12 +1383,13 @@ erc-button--display-error-notice-with-keys erc-modules erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) (erc-mode) - (erc-button-mode +1) (erc-tests--set-fake-server-process "sleep" "1") - (erc-tests--send-prep) - (erc-button--display-error-notice-with-keys - "If \\[erc-bol] fails, " - "see \\[erc-bug] or `erc-mode-map'.") + (erc--initialize-markers (point) nil) + (erc-button-mode +1) + (should (equal (erc-button--display-error-notice-with-keys + "If \\[erc-bol] fails, " + "see \\[erc-bug] or `erc-mode-map'.") + "*** If C-a fails, see M-x erc-bug or `erc-mode-map'.")) (goto-char (point-min)) (ert-info ("Keymap substitution succeeds") -- 2.39.1