From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: "J.P." Newsgroups: gmane.emacs.bugs Subject: bug#60933: 30.0.50; ERC >5.5: Make buttonizing more extensible Date: Thu, 09 Mar 2023 06:42:07 -0800 Message-ID: <87fsaekmv4.fsf__39101.0304259666$1678373014$gmane$org@neverwas.me> References: <878rhzc3gk.fsf@neverwas.me> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="14673"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: emacs-erc@gnu.org To: 60933@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Thu Mar 09 15:43:27 2023 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1paHUM-0003f4-FR for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 09 Mar 2023 15:43:26 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1paHTz-0007Og-S0; Thu, 09 Mar 2023 09:43:03 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1paHTy-0007Nq-Fq for bug-gnu-emacs@gnu.org; Thu, 09 Mar 2023 09:43:02 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1paHTy-00009A-7Y for bug-gnu-emacs@gnu.org; Thu, 09 Mar 2023 09:43:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1paHTy-0003VS-3j for bug-gnu-emacs@gnu.org; Thu, 09 Mar 2023 09:43:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 09 Mar 2023 14:43:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 60933 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 60933-submit@debbugs.gnu.org id=B60933.167837294213419 (code B ref 60933); Thu, 09 Mar 2023 14:43:02 +0000 Original-Received: (at 60933) by debbugs.gnu.org; 9 Mar 2023 14:42:22 +0000 Original-Received: from localhost ([127.0.0.1]:51264 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1paHTI-0003UL-Km for submit@debbugs.gnu.org; Thu, 09 Mar 2023 09:42:22 -0500 Original-Received: from mail-108-mta182.mxroute.com ([136.175.108.182]:39741) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1paHTF-0003U4-Lv for 60933@debbugs.gnu.org; Thu, 09 Mar 2023 09:42:19 -0500 Original-Received: from mail-111-mta2.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta182.mxroute.com (ZoneMTA) with ESMTPSA id 186c6d28648000edb4.001 for <60933@debbugs.gnu.org> (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES128-GCM-SHA256); Thu, 09 Mar 2023 14:42:11 +0000 X-Zone-Loop: 842093f9ed612b5c72c7d8eee83819418b1046db656d X-Originating-IP: [136.175.111.2] DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=neverwas.me ; s=x; h=Content-Type:MIME-Version:Message-ID:Date:References:In-Reply-To: Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding:Content-ID: Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc :Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=IWouYqXHTtMj6NKOZy5gRVP+GjU7KFhVzQC25CerIWQ=; b=j+zqABvaYtMFD9XMay8gIK8csp EA8Ai0+EU1Zme62X/YWtoUpF8BiZNgaBzQZjDMZnGME0dMY007zdaUZP4FBnikVI4fVANiQz9zWNy q3qP1mpePtuLbh6K560ZZk2T0qv/EUlGZKF1vkHoCxNk5btWIO1mADVuGeh9kFyZJVXCRCXa8tScd a3hU8OdVHoPVUuPXZ2ucZkUfJacH9FT73Bq8M9Y3xrY4070Vo8AIs9XvZIEZfAbxc0I2u389v/X/v RIpJZ4MUlwV38nkU265tBjGDyjmQAjN01X/Ie+0dr+0X+LRYxfsOqhEuuXxxiLWTrY2OLSQFS+1Mr wIkloXVw==; In-Reply-To: <878rhzc3gk.fsf@neverwas.me> (J. P.'s message of "Wed, 18 Jan 2023 06:38:51 -0800") X-Authenticated-Id: masked@neverwas.me X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:257618 Archived-At: --=-=-= Content-Type: text/plain v3. Expand `erc-button-alist' pattern to recognize inline (info "...") forms. Autoload button helpers (locally, in ERC's own loaddefs). --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: attachment; filename=0000-v2-v3.diff Content-Transfer-Encoding: quoted-printable >From 28517cf23b5ed65f8a421dddcffec6a0aecd7fe5 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 9 Mar 2023 06:28:53 -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 | 172 +++++++++++++++++++++++++++++++++---- lisp/erc/erc-networks.el | 22 ++--- test/lisp/erc/erc-tests.el | 56 ++++++++++++ 3 files changed, 220 insertions(+), 30 deletions(-) Interdiff: diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 49e3caf49a1..c94a412eea8 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -134,7 +134,7 @@ erc-button-alist ("[`=E2=80=98]\\([a-zA-Z][-a-zA-Z_0-9!*<=3D>+]+\\)['=E2=80=99]" 1 t erc-button-describe-symbol 1) ;; pseudo links - ("\\bInfo:[\"]\\([^\"]+\\)[\"]" 0 t info 1) + ("\\(?:\\bInfo: ?\\|(info \\)[\"]\\(([^\"]+\\)[\"])?" 0 t info 1) ("\\b\\(Ward\\|Wiki\\|WardsWiki\\|TheWiki\\):\\([A-Z][a-z]+\\([A-Z][a-= z]+\\)+\\)" 0 t (lambda (page) (browse-url (concat "http://c2.com/cgi-bin/wiki?" page))) @@ -600,25 +600,39 @@ erc-button--substitute-command-keys-in-region (insert s)) (cons beg (point))) =20 -(defun erc-button--display-error-notice-with-keys (parsed &rest strings) - "Add help keys to STRINGS for corner-case admonishments. -Return inserted result." +;;;###autoload +(defun erc-button--display-error-notice-with-keys (&optional parsed buffer + &rest strings) + "Add help keys to STRINGS for configuration-related admonishments. +Return inserted result. PARSED can be an `erc-response' object, +a string, or nil. BUFFER can be a buffer, a string, or nil. As +a special case, PARSED can also be a buffer as long as BUFFER is +a string or nil." + (when (stringp buffer) + (push buffer strings) + (setq buffer nil)) (when (stringp parsed) (push parsed strings) (setq parsed nil)) + (when (bufferp parsed) + (cl-assert (null buffer)) + (setq buffer parsed + parsed nil)) (let* ((string (apply #'concat strings)) (erc-insert-post-hook (cons (lambda () - (setq string (buffer-substring (point-min) (1- (point-ma= x))))) + (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) + (erc-display-message parsed '(notice error) (or buffer 'active) string) string)) =20 +;;;###autoload (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))) --=20 2.39.2 --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: attachment; filename=0001-5.6-Replace-Info-goto-node-with-info-in-erc-button-a.patch Content-Transfer-Encoding: quoted-printable >From f61bd6bb6129571327cdb9e68b38e8221b72d91e Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 18 Dec 2022 19:01:40 -0800 Subject: [PATCH 1/3] [5.6] Replace Info-goto-node with info in erc-button-alist * lisp/erc/erc-button.el (erc-button-alist): Replace `Info-goto-node' with plain `info', which is autoloaded. Expand regexp to recognize inline `info' function calls. * lisp/erc/erc-networks.el (erc-networks--set-name, erc-networks--warn-on-connect): Don't require `info'. (Bug#60933.) --- lisp/erc/erc-button.el | 2 +- lisp/erc/erc-networks.el | 2 -- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index c28dddefa0e..891b453466f 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -133,7 +133,7 @@ erc-button-alist ("[`=E2=80=98]\\([a-zA-Z][-a-zA-Z_0-9!*<=3D>+]+\\)['=E2=80=99]" 1 t erc-button-describe-symbol 1) ;; pseudo links - ("\\bInfo:[\"]\\([^\"]+\\)[\"]" 0 t Info-goto-node 1) + ("\\(?:\\bInfo: ?\\|(info \\)[\"]\\(([^\"]+\\)[\"])?" 0 t info 1) ("\\b\\(Ward\\|Wiki\\|WardsWiki\\|TheWiki\\):\\([A-Z][a-z]+\\([A-Z][a-= z]+\\)+\\)" 0 t (lambda (page) (browse-url (concat "http://c2.com/cgi-bin/wiki?" page))) diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 95fd8990c99..4337d633cfa 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -1292,7 +1292,6 @@ erc-networks--set-name erc-server-announced-name "\" in `erc-networks-alist'" " or consider calling `erc-tls' with the keyword `:id= '." " See Info:\"(erc) Network Identifier\" for more."))) - (require 'info) (erc-display-error-notice parsed m) (if erc-networks--allow-unknown-network (progn @@ -1514,7 +1513,6 @@ erc-networks--warn-on-connect "Emit warning when the `networks' module hasn't been loaded. Ideally, do so upon opening the network process." (unless (or erc--target erc-networks-mode) - (require 'info nil t) (let ((m (concat "Required module `networks' not loaded. If this " " was unexpected, please add it to `erc-modules'."))) ;; Assume the server buffer has been marked as active. --=20 2.39.2 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-5.6-Add-erc-button-helper-for-substituting-command-k.patch >From 5fb14bbc6535acfabcec5afe89613528e1b405b5 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 18 Dec 2022 19:01:40 -0800 Subject: [PATCH 2/3] [5.6] Add erc-button helper for substituting command keys TODO: add ERC-NEWS entry for `erc-button-alist' field-type deprecation once ERC 5.5 is released and a new section for 5.6 is added. * lisp/erc/erc-button.el (erc-button-mode, erc-button-enable): Warn if `erc-button-alist' contains deprecated FORM field in `nicknames' entry. (erc-button-alist): Deprecate arbitrary sexp form for third item of entries and offer more useful bounds-modifying function in its place. Mention that anything other than `erc-button-buttonize-nicks' is deprecated as the FORM field in a `nicknames' entry. (erc-button--maybe-warn-arbitrary-sexp): Add helper for validating third `erc-button-alist' field. (erc-button--check-nicknames-entry): Add helper to check for deprecated items in `erc-button-alist'. (erc-button--modify-nick-function): Add new variable to hold a function that filters nickname bounds when buttonizing. (erc-button--preserve-bounds): Add function to serve as default value for `erc-button--modify-nick-function). (erc-button-add-nickname-buttons): Accommodate function variant for "form" field of `erc-button-alist' entries. Minor optimizations. (erc-button-add-buttons-1): Show warning when arbitrary sexp for third "form" field encountered. Accommodate binary function instead. (erc-button--substitute-command-keys-in-region): Add new function to serve as default key-substitution function item in `erc-button-alist'. (erc-button--display-error-notice-with-keys): Add new helper function for displaying ad hoc warnings that possibly require key substitution. * lisp/erc/erc-networks.el (erc-networks--ensure-announced, erc-networks--on-MOTD-end): Use new key-substitutions helper from erc-button. (erc-button--display-error-notice-with-keys-and-warn): Add new function to both display an ERC error message and show a warning. * test/lisp/erc/erc-tests.el (erc-button--display-error-notice-with-keys): New test. (Bug#60933.) --- lisp/erc/erc-button.el | 151 ++++++++++++++++++++++++++++++++++--- lisp/erc/erc-networks.el | 20 ++--- test/lisp/erc/erc-tests.el | 56 ++++++++++++++ 3 files changed, 207 insertions(+), 20 deletions(-) diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 891b453466f..eca3df44892 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)) @@ -165,8 +166,17 @@ erc-button-alist BUTTON is the number of the regexp grouping actually matching the button. This is ignored if REGEXP is `nicknames'. -FORM is a Lisp expression which must eval to true for the button to - be added. +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. CALLBACK is the function to call when the user push this button. CALLBACK can also be a symbol. Its variable value will be used @@ -176,7 +186,7 @@ erc-button-alist CALLBACK. There can be several PAR arguments. If REGEXP is `nicknames', these are ignored, and CALLBACK will be called with the nickname matched as the argument." - :package-version '(ERC . "5.5") + :package-version '(ERC . "5.6") ; FIXME sync on release :type '(repeat (list :tag "Button" (choice :tag "Matches" @@ -275,22 +285,79 @@ erc-button-add-buttons (concat "\\<" (regexp-quote (car elem)) "\\>") 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))) + +(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 (or (eq t form) - (eval form t)) + (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))) (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))) - (when (or (and (erc-server-buffer-p) (erc-get-server-user word)) - (and erc-channel-users (erc-get-channel-user word))) - (erc-button-add-button (car bounds) (cdr bounds) - fun t (list word)))))))) + (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))))) + (when (and user + (or (not (functionp form)) + (setq bounds + (funcall form bounds down user (cdr cuser))))) + (erc-button-add-button (car bounds) (cdr bounds) + fun t (list word))))))))) (defun erc-button-add-buttons-1 (regexp entry) "Search through the buffer for matches to ENTRY and add buttons." @@ -302,7 +369,14 @@ erc-button-add-buttons-1 (fun (nth 3 entry)) (data (mapcar #'match-string-no-properties (nthcdr 4 entry)))) (when (or (eq t form) - (eval form t)) + (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))))) (defun erc-button-remove-old-buttons () @@ -511,6 +585,61 @@ erc-button-beats-to-time (message "@%s is %d:%02d local time" beats hours minutes))) +(defun erc-button--substitute-command-keys-in-region (beg end) + "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))) + +;;;###autoload +(defun erc-button--display-error-notice-with-keys (&optional parsed buffer + &rest strings) + "Add help keys to STRINGS for configuration-related admonishments. +Return inserted result. PARSED can be an `erc-response' object, +a string, or nil. BUFFER can be a buffer, a string, or nil. As +a special case, PARSED can also be a buffer as long as BUFFER is +a string or nil." + (when (stringp buffer) + (push buffer strings) + (setq buffer nil)) + (when (stringp parsed) + (push parsed strings) + (setq parsed nil)) + (when (bufferp parsed) + (cl-assert (null buffer)) + (setq buffer parsed + parsed nil)) + (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-message parsed '(notice error) (or buffer 'active) string) + string)) + +;;;###autoload +(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) ;;; erc-button.el ends here diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 4337d633cfa..dd481032e7e 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -67,6 +67,9 @@ erc-session-server (declare-function erc-server-process-alive "erc-backend" (&optional buffer)) (declare-function erc-set-active-buffer "erc" (buffer)) +(declare-function erc-button--display-error-notice-with-keys + (parsed &rest strings)) + ;; Variables (defgroup erc-networks nil @@ -1310,12 +1313,11 @@ erc-networks--ensure-announced Copy source (prefix) from MOTD-ish message as a last resort." ;; The 004 handler never ran; see 2004-03-10 Diane Murray in change log (unless erc-server-announced-name - (setq erc-server-announced-name (erc-response.sender parsed)) - (erc-display-error-notice - parsed (concat "Failed to determine server name. Using \"" - erc-server-announced-name "\" instead." - " If this was unexpected, consider reporting it via " - (substitute-command-keys "\\[erc-bug]") "."))) + (require 'erc-button) + (erc-button--display-error-notice-with-keys + parsed "Failed to determine server name. Using \"" + (setq erc-server-announced-name (erc-response.sender parsed)) "\" instead" + ". If this was unexpected, consider reporting it via \\[erc-bug]" ".")) nil) (defun erc-unset-network-name (_nick _ip _reason) @@ -1493,9 +1495,9 @@ erc-networks-on-MOTD-end (memq (erc--target-symbol erc--target) erc-networks--bouncer-targets))) proc) - (let ((m (concat "Unexpected state detected. Please report via " - (substitute-command-keys "\\[erc-bug]") "."))) - (erc-display-error-notice parsed m)))) + (require 'erc-button) + (erc-button--display-error-notice-with-keys + parsed "Unexpected state detected. Please report via \\[erc-bug]."))) ;; For now, retain compatibility with erc-server-NNN-functions. (or (erc-networks--ensure-announced proc parsed) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index d6c63934163..05f0de6b195 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1370,4 +1370,60 @@ define-erc-module--local (put 'erc-mname-enable 'definition-name 'mname) (put 'erc-mname-disable 'definition-name 'mname)))))) + +;; XXX move erc-button tests to new file if more added. +(require 'erc-button) + +;; See also `erc-scenarios-networks-announced-missing' in +;; erc-scenarios-misc.el for a more realistic example. +(ert-deftest erc-button--display-error-notice-with-keys () + (with-current-buffer (get-buffer-create "*fake*") + (let ((mode erc-button-mode) + (inhibit-message noninteractive) + erc-modules + erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) + (erc-mode) + (erc-tests--set-fake-server-process "sleep" "1") + (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") + (erc-button-next) + (should (looking-at "C-a")) + (should (eq (get-text-property (point) 'mouse-face) 'highlight)) + (erc-button-press-button) + (with-current-buffer "*Help*" + (goto-char (point-min)) + (should (search-forward "erc-bol" nil t))) + (erc-button-next) + (erc-button-previous) ; end of interval correct + (should (looking-at "a fails"))) + + (ert-info ("Extended command mapping succeeds") + (erc-button-next) + (should (looking-at "M-x erc-bug")) + (erc-button-press-button) + (should (eq (get-text-property (point) 'mouse-face) 'highlight)) + (with-current-buffer "*Help*" + (goto-char (point-min)) + (should (search-forward "erc-bug" nil t)))) + + (ert-info ("Symbol-description face preserved") ; mutated by d-e-n-w-k + (erc-button-next) + (should (equal (get-text-property (point) 'font-lock-face) + '(erc-button erc-error-face))) + (should (eq (get-text-property (point) 'mouse-face) 'highlight)) + (should (eq erc-button-face 'erc-button))) ; extent evaporates + + (when noninteractive + (unless mode + (erc-button-mode -1)) + (kill-buffer "*Help*") + (kill-buffer))))) + ;;; erc-tests.el ends here -- 2.39.2 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-5.6-Allow-erc-button-add-face-to-take-an-object.patch >From 28517cf23b5ed65f8a421dddcffec6a0aecd7fe5 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 13 Jan 2023 05:13:06 -0800 Subject: [PATCH 3/3] [5.6] Allow erc-button-add-face to take an object * lisp/erc/erc-button.el (erc-button--add-nickname-face-function): New internal var. (erc-button-add-button): Call `erc-button--add-nickname-face-function' when it's a function for applying `erc-button-nickname-face'. (erc-button-add-face): Add optional `object' param. (Bug#60933.) --- lisp/erc/erc-button.el | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index eca3df44892..c94a412eea8 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -391,6 +391,8 @@ erc-button-remove-old-buttons mouse-face nil keymap nil))) +(defvar erc-button--add-nickname-face-function nil) + (defun erc-button-add-button (from to fun nick-p &optional data regexp) "Create a button between FROM and TO with callback FUN and data DATA. NICK-P specifies if this is a nickname button. @@ -417,7 +419,10 @@ erc-button-add-button (move-marker pos (point)))))) (if nick-p (when erc-button-nickname-face - (erc-button-add-face from to erc-button-nickname-face)) + (if erc-button--add-nickname-face-function + (funcall erc-button--add-nickname-face-function + from to erc-button-nickname-face) + (erc-button-add-face from to erc-button-nickname-face))) (when erc-button-face (erc-button-add-face from to erc-button-face))) (add-text-properties @@ -429,16 +434,16 @@ erc-button-add-button (list 'rear-nonsticky t) (and data (list 'erc-data data))))) -(defun erc-button-add-face (from to face) +(defun erc-button-add-face (from to face &optional object) "Add FACE to the region between FROM and TO." ;; If we just use `add-text-property', then this will overwrite any ;; face text property already used for the button. It will not be ;; merged correctly. If we use overlays, then redisplay will be ;; very slow with lots of buttons. This is why we manually merge ;; face text properties. - (let ((old (erc-list (get-text-property from 'font-lock-face))) + (let ((old (erc-list (get-text-property from 'font-lock-face object))) (pos from) - (end (next-single-property-change from 'font-lock-face nil to)) + (end (next-single-property-change from 'font-lock-face object to)) new) ;; old is the face at pos, in list form. It is nil if there is no ;; face at pos. If nil, the new face is FACE. If not nil, the @@ -446,10 +451,10 @@ erc-button-add-face ;; where this face changes. (while (< pos to) (setq new (if old (cons face old) face)) - (put-text-property pos end 'font-lock-face new) + (put-text-property pos end 'font-lock-face new object) (setq pos end - old (erc-list (get-text-property pos 'font-lock-face)) - end (next-single-property-change pos 'font-lock-face nil to))))) + old (erc-list (get-text-property pos 'font-lock-face object)) + end (next-single-property-change pos 'font-lock-face object to))))) ;; widget-button-click calls with two args, we ignore the first. ;; Since Emacs runs this directly, rather than with -- 2.39.2 --=-=-=--